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INTRODUCTION 


The  use  of  composite  materials  and  structures  to  provide 
characteristics  unattainable  directly  from  the  constituent 
materials  is  well  known.  Perhaps  the  most  widespread  example  is 
steel-reinforced  concrete  wherein  the  high  tensile  strength  of 
steel  in  conjunction  with  the  high  compressive  strength  of 
concrete  yields  a  composite  material  with  structural  properties 
far  superior  to  those  of  either  constituent.  More  recently,  work 
has  been  undertaken  to  apply  this  principle  to  the  development  of 
new  dielectric  materials  for  use  in  capacitors  with  greater 
energy  density,  lower  loss,  and  higher  breakdown  resistance  [1]. 
High  permittivity  dielectrics  are  necessary  to  achieve  high 
energy  densities,  however  high  permittivity  is  usually  associated 
with  high  loss.  Low  loss  is  similarly  associated  with  low 
permittivity  and  low  energy  density  dependent  on  loss  tangent. 
Composite  dielectrics  of  appropriate  combinations  of  constituent 
materials  may  shew  high  overall  permittivity  with  small  loss  even 
though  one  or  more  of  the  constituents  has  large  individual  loss. 
This  is  known  as  the  Maxwell-Wagner  effect  [2-4]. 


The  net  dielectric  behavior  of  a  randomly  interspersed 
composite  is  dependent  on  the  spatial  dimensionality  (1-D  vs.  2-D 
vs.  3-D),  domain  geometries  (domain  size,  domain  shape, 
stratification,  etc.),  interconnection  effects  (percolation),  and 
fractalization  (interfaces  or  connectedness  per  unit  volume).  A 
se 1 f -simi larity  averaging  law  which  is  useful  to  the  dielectric 
engineer  is  Lichtenecker ’ s  formula  [5,6] 


where  e  is  the  resultant  permittivity  of  the  composite,  a  is  an 
exponential  averaging  factor  (-1  <  a  v  +1) ,  and  the  summation  is 
over  the  constituent  species  with  permittivity  and  volume 
fraction  Vj,.  respectively.  This  formula  can  be  justified 
theoretically  to  apply  to  random  (self-similar,  scaleless)  and 
history  invariant  composites.  The  permittivity  e  is  defined 
tully  in  terms  of  the  electric  and  displacement  fields  and  is 
trequency  dependent.  The  factor  a  is  referred  to  as  the 
exponential  averaging  factor  or  self-similarity  factor.  The 
behavior  of  this  factor  has  certain  values  in  special  limiting 
cases  and  was  originally  called  a  "formzahl"  (form  number)  by 
Wiener  [7].  In  the  case  or  isotropic  flat  layers  with  surface 
normals  oriented  parallel  to  the  applied  electric  field,  a  =  -1, 
and  for  isotropic  flat  layers  with  surface  normals  perpendicular 
to  the  applied  electric  field  direction,  a  =  +1.  The  mathematical 
interpretations  of  the  exponential  averaging  factor  for  the 
following  values  are:  +1  =  'arithmetic'  averaging, 
o  'geometric'  (or  logarithmic)  averaging,  and  -1  =  'harmonic' 
averaging.  In  regard  to  the  physical  problem  of  randomly 
interspersed  dielectric  composites  with  a  self-similarity,  the 
values  of  the  exponential  averaging  factor  are  only  known  to  lie 
within  these  bounds  [7-12].  The  exponential  averaging  factor  a 
however  doer,  offer  a  useful  way  of  presenting  results  and  general 
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trends  in  a  comparative  sense  to  one  another. 

A  second  factor  which  is  also  bounded  is  the  depolarization 
factor  'A'.  The  depolarization  factor  is  a  geometrical  factor 
that  arises  from  a  self-consistent  treatment  of  the  dielectric 
problem  where  ellipsoidal  domains  are  each  surrounded  by  an 
effective  medium  host.  This  picture  is  usually  the  lowest  order 
scattering  approximation  where  the  dielectric  grains  are  much 
smaller  than  any  associated  electromagnetic  wavelengths.  The 
actual  composite  grains  may  be  distant  from  the  ellipsoidal 
shape,  especially  when  dealing  with  mixtures  not  dominated 
strongly  by  any  particular  species.  This  approach  is  referred  to 
as  the  effective-medium-theory  coherent-potential-approximation 
(EMT-CPA)  and  has  been  derived  in  several  manners  [13-15].  It  is 
most  succinctly  expressed  as 


Aek- (1-A) e 


The  depolarization  factor  'A'  can  be  determined  by  an  integral 
which  is  taken  over  the  shape  of  the  ellipsoid  and  is  discussed 
in  Appendix  A  [11,  16-18].  In  the  case  of  a  spheroid  situated  in 
N  spatial  dimensions  the  depolarization  is  simply  A  =  1/N. 

Our  analysis  will  be  presented  in  both  forms:  the 
exponential  averaging  factor  ' a ’  and  the  depolarization  factor 
'A'.  The  exponential  averaging  factor  'a'  may  be  thought  of  as  a 
measure  of  the  degree  between  series  and  parallel-like  extrema  or 
Wiener  bounds  of  the  composite.  The  depolarization  'A'  is  a 
measure  of  geometric  grain  shape  in  terms  of  the 
effective-medium-theory  coherent-potential-approximation  (EMT- 
CPA)  .  In  the  limit  where  the  constituents  of  the  composite  are 
dielectrically  infinitesimally  close,  the  relation  a  ~  (1  -  2A) 
holds.  It  is  interesting  to  note  that  equations  (1)  and  (2)  are 
first  order  approximations  to  each  other  in  the  close  constituent 
permittivity  limit  even  though  the  formulae  appear  quite 
different.  However,  when  constituents  having  largely  different 
permittivities'  are  examined  using  our  numerical  program,  the 
composite  mixture  formulae  yield  different  predictions  [1]-  Both 
methods  allow  us  to  present  our  numerical  simulation  results  in  a 
comparative  way  which  is  useful  for  both  theoretical  and 
experimental  analysis. 

ELECTRIC  DISPLACEMENT  FIELD 

The  electric  field  E(r,t)  is  defined  as  the  electric  force 
per  unit  charge  acting  on  a  stationary  test  charge  located  at 
point  r  and  at  time  t  (Boldface  notation  will  be  employed 
throughout  this  report  to  represent  vector  and  tensor 
quantities).  The  displacement  field  D(r,t)  as  used  in  this  report 
is  the  universal  displacement  field  which  arises  from  the 
combination  of  Gauss's  Law  with  charge  continuity  (conservation). 
The  result  is  a  continuous  flux  quantity.  In  the  standard 
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international  (SI)  MKSA  unit  format,  these  two  relations  are 
respectively 

VE(r,t)  =  Pq ( r , t ) / e  Q  (3) 

where  V-  is  the  spatial  divergence  operator,  pQ(r,t)  is  the 
volume  charge  density  and  eQ  is  the  permittivity  or  free  space, 
and 


V-JQ(r,t)  =  -  dpQ(r,t)/dt  (4) 

where  jQ(r,t)  is  the  charge  current  density  (charge  current  per 
unit  area).  A  generalized  charge  polarization  field  Pg(r,t)  is 
linked  to  the  charge  density  by  the  following  def ining  relation 
for  PQ(r,t) 

V-PQ(r,t)  s  -  Pq (r , t)  .  (5) 

Upon  partial  time  differentiation  of  eguation  (5)  and  comparing 
to  the  continuity  equation  (4)  one  finds  the  identity 

PQ  (r '  t)  /  t  =  Jq  (r ,  t)  .  (6) 

Segregation  of  charge  types  may  be  introduced  when  desired,  but 
is  not  necessary  for  the  derivation  and  application  of  a 
generalized  permittivity  [19]  as  in  this  report.  A  polarization 
field  for  discrete  point  charges  in  an  inertial  coordinate  system 
from  equation  (5)  could  be 

PQ(r,t)  =  f  qiri  .  (7) 

rn  equation  (7)  the  summation  is  over  all  charges  q^  at  locations 
r-  within  the  medium.  Combining  equation  (3)  and  equation  (5) 
y  ields 

{ eQV- E(r, t)  +  V-PQ(r,t) 

Rearranging  the  brackets  of 
divergence  relation 


V- {coE(r,t)  +  PQ (r , t) }  =  0 

(9) 

V- D(r, t)  =0 

(10) 

where  t he  quantity  in  the  brackets  becomes  the  definition  of  the 
generalized  or  universal  electric  displacement  field  [20] 

D ( r , t )  =  r0E(r,t)  +  PQ (r, t )  .  (11) 

(•'or  brevity,  this  generalized  field  will  be  referred  to  as  the 
'D-f  ield'  elsewhere  in  this  report.  The  time  derivative  of  the 
D-field  gives  the  generalized  or  universal  displacement  current 
dens i ty 


}  =  0  .  (8) 
equation  (8)  results  in  the 
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(12) 


D(r , t) /  t  =  JD(r,t)  , 

referred  to  by  Maxwell  as  the  'true  current'  and  the  D-field  can 
be  referred  to  as  'true*  also  [21].  From  the  combination  of 
fundamental  laws  (3)  and  (4)  with  (11)  and  (12),  it  follows  that 
the  universal  current  density  is  always  divergenceless  and 
continuous  with 

V-JD(r,t)  =  0  .  (13) 

Conversely,  one  might  say  that  according  to  equation  (12),  the 
antiderivative  (in  time)  of  the  universal  current  density  is  a 
vector  field  called  the  universal  displacement  field.  The 
physical  units  of  the  displacement  field  are  charge  polarization 
per  unit  volume  or  that  of  surface  charge  density. 

Dielectric  measurements  and  analysis  are  often  made  in  the 
frequency  domain  [22,  23].  In  the  case  where  the  displacement 

field  is  periodic  with  time  it  can  be  Fourier  decomposed  as 

D(r ,  t)  =  J  D(r ,  f )  e+j27rft  df  (14) 

or  conversely 

D (r , f )  =  |  D(r, t)  e~j2nft  2n  dt  (15) 

where  D(r,f)  is  the  electric  displacement  field  Fourier  component 
at  frequency  f,  j  s=v-l,  and  integrations  respectively  are  over 
all  f  and  t.  The  frequency  domain  transformation  of  equation  (10) 
gives 

VD(r,f)=  O  ,  (16) 

or  equivalently  from  combination  of  equations  (12)  and  (13) 

V- {j  2n f  D(r , f) }  =  0  (17) 

for  f  f  O  (non-static  fields).  The  relation  expressed  by 
equation  (12)  becomes  in  the  frequency  domain 

j  2Tif  D(r ,  f )  =  JD(r,f)  (18) 

and  so  it  is  easy  to  transpose  between  equations  (16)  and  (17). 

In  most  natural  media,  the  universal  electric  displacement 
field  evolves  by  a  collective  decay  from  the  past  history  ol 
electric  fields  which  are  or  have  been  impressed  upon  the  medium. 
This  is  expressed  by  the  convolution 

D(r,  t)  =  J**  f(r,t-t')  E(r,f)  dt  •  (19) 

or  alternately  upon  change  of  integration  variable  to  u  defined 

as  u  s  t-t ' , 
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(20) 


D(r,t)  =  J“  f(r,u)  E(r,t-u)  du 

where  D(r,t)  is  the  displacement  field  at  the  present  time, 
B(r,t)  is  the  electric  field  from  the  past  to  the  present,  the 
function  t(r,u)  =  df (r,u) /du  represents  the  history  or  decay 
correlation  between  the  fields  and  u  =  t-t '  is  the  present  to 
past  time  connection  variable.  The  function  f(r,u)  is  referred 
to  as  the  normalized  displacement  decay  current  or,  in  short, 
decay  current.  The  accumulation  of  normalized  displacement  decay 
current  is  called  the  normalized  displacement  decay  function 
jf(r,u)  or,  in  short,  decay  function.  The  dimensions  of  the  decay 
function  /(r,u)  are  displacement  field  per  electric  field. 
Causality  requires  that  the  decay  current  l:(r,t-t')  be  zero  when 
t'>t  or  u<0  (i.e.,  no  correlation  with  the  future).  In  the  time 
domain  both  the  displacement  and  electric  fields  must  be  real 
valued  and  hence  the  normalized  displacement  decay  current  f(r,u) 
must  also  be  real  valued.  If  the  medium  is  linear  then  the  decay 
current  /(r,u)  is  independent  of  the  electric  field  in  the 
medium.  For  example  if  the  decay  function  f(r,u)  is  just  a  step 
function  (from  zero)  at  u  =  t-t1  =  O  then  equations  (19)  and  (20) 
reproduce  an  instantaneous  correlation  between  the  electric  and 
displacement  fields.  In  the  next  section  we  will  discuss  the 
implications  of  these  physical  constraints  upon  dielectric 
permittivity  behavior. 

in  summary,  a  universal  electric  displacement  field  or  'D- 
tield'  can  be  defined  which  is  inclusive  of  all  charges.  This 
generalized  D-field  is  necessary  for  use  in  dielectric 
composites.  Provided  there  are  no  unaccounted  for  sources, 
sinks,  or  charge  accumulations,  then  this  field  is  divergenceless 
and  continuous.  A  normalized  displacement  decay  current/function 
can  be  introduced  to  statistically  relate  the  present  observed 
displacement  field  to  the  past  electric  field  history. 

DIELECTRIC  PERMITTIVITY 

Dielectric  permittivity  is  defined  by  a  tensor  relationship 
between  the  electric  and  displacement  field  vectors  in  the 
frequency  domain  which  may  be  expressed  as 

D(r, f )  -  £(r,f) -5(r,f)  (21) 

wrier  e  E(r,l)  and  D(r,f)  are  respectively  the  electric  and 
universal  displacement  fields  at  a  location  r  and  frequency  f. 
Alternately  this  ’~e la t ionsh ip  can  be  expressed  using  spatial 
index  notation 

Dj(r,f)  =  €i j (r , f )  Ej(r,f)  .  (22) 

The  dielectric  permittivity  e^j(r,f)  is  a  tensor  of  rank  two. 

The  dielectric  permittivity  is  defined  in  the  frequency 
regime  because,  strictly  speaking,  there  are  no  known  substances 
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(except  vacuum)  which  exhibit  complete  instantaneous  displacement 
response  to  the  application  of  an  electric  field.  The 
implication  of  this  fact  is  that  there  are  no  completely  static- 
time  domain  constants  between  electric  and  displacement  fields. 
Rather  there  exists  a  time  correlation  behavior  between  the 
present  displacement  field  and  the  past  applied  electric  fields. 
This  is  expressed  by  equations  (19)  and  (20)  and  the  normalized 
displacement  decay  current  f(r,t-t')  or  through  its  accumulation 
as  the  normalized  displacement  decay  function  f(r,t-t').  The 
frequency  domain  transformation  of  the  ccnvolution  relation 
expressed  by  equations  (19)  and  (20)  produces  the  needed  relation 
connecting  the  frequency  domain  permittivity  e(r,f)  with  the 
normalized  displacement  decay  current  t( r,t-t')  of  the  time 
domain  as 


e(r,f)  =  f(r,u)  e+j277fu  du 


(2  3) 


where  the  time  variable  is  u  =  t-t' .  Because  the  decay  current 
and  decay  function  are  real  valued,  the  frequency  domain 
permittivity  e(r,f)  is  necessarily  complex  valued  unless  the 
decay  function  is  instantaneous.  Traditionally,  in  the  1 ield  of 
dielectrics,  this  is  expressed  as 


c(r,f)  =  c'(r,f)  +  j  e" (r , f )  (24) 

where  e'(r,f)  and  €"(r,f)  are  respectively  the  real  and  imaginary 
parts  of  the  dielectric  permittivity.  The  imaginary  part  ot 
permittivity  is  known  as  the  "lossy”  part  as  it  is  proportional 
to  the  energy  lost  during  a  cycle  of  a  time  harmonic  field. 

When  a  medium  is  isotropic,  both  the  displacement  and 
electric  field  vectors  are  colinear  and  the  permittivity  can  be 
regarded  as  the  scalar  ratio  e(r,f)  of  the  fields  D (r , f ) / K ( r , f  )  . 
In  situations  where  the  medium  is  anisotropic  or  biref r i nqent , 
then  the  fields  are  reoriented  locally  until  they  lie  along  the 
direction  of  a  principal  axis  of  the  local  permittivity  tensor. 
In  this  alignment  the  fields  are  colinear  and  their  ratio  can  be 
measured  as  before  as  the  corresponding  element  in  the 
diagonalized  permittivity  tensor.  In  the  general  anisotropic 
situation  where  the  principal  directions  may  not  experimentally 
be  possible  to  determine,  measurements  have  to  be  made  of  all 
spatial  aspects  pertaining  to  both  field  vectors.  For  isotropic 
dielectrics  where  the  permittivities  are  scalar  and  spatially 
uniform,  the  ratio  of  the  imaginary  to  real  part  of  the 
permittivity  is  called  the  loss  tangent  or  dissipation  factor 
[24,  25].  This  is  conventionally  written  as 


e"(r,f)/e* (r,f)  =  tan  5(r,f)  .  (25) 

In  this  report  we  will  examine  the  case  of  random  (Monte 
Carlo)  composite  media  simulations  with  a  high  degree  of 
macroscopic  isotropy.  Expansion  to  anisotropic  cases  is 
anticipated  in  future  work. 
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As  an  illustrative  case,  when  the  decay  function  is 
isotropic  and  spatial ly  uni f orm  with  an  exponential  decay 
f(t)  =  €A  (1  -  e-*'/'*’)  (reflecting  a  viscous  type  relaxation),  it 
transforms  into  the  familiar  simple  form  of  Debye  relaxation 

e(f)  =  Jo  (cA/t> (e~t/T) (e+^2nfu)  du  (26) 

e(f)  =  eA/(l  -  j2nfT)  (27) 

where  eA  is  the  transition  permittivity  (a  constant) ,  and  T  is 
the  viscous  relaxation  time.  Note  that  e(f)  here  is  a  complex 
numbered  quantity  expressible  as  the  real  and  imaginary  pair 

e'  (f)  =  eA/[l  +(2rrf T)2]  (28) 

arid 

e"(f)  =  eA  27rfT/[l  +  ( 2nfT)  2  ]  .  (29) 

An  interesting  feature  of  the  Debye  relaxation  permittivity  is 
that  the  complex  plane  plot  of  e'(f)  and  e"(f)  reveals  a 
semicircle  as  frequency  is  varied.  This  type  of  plot  is  often 
referred  to  as  the  Cole-Cole  plot  and  is  useful  as  a  way  of 
identifying  the  relaxation  as  well  as  fingerprinting  permittivity 
characteristics.  Elimination  of  the  explicit  frequency  variable 
on  the  right  hand  sides  of  the  above  equation  pair  does  indeed 
verify  a  semicircle  of  radius  €A/2  whose  imaginary  part  reaches 
its  maximum  value  when  the  frequency  is  at  1/ZnT. 

CONDUCTIVITY 

A  universal  displacement  conductivity  a(r,f)  is  defined  by  a 
tensor  relationship  between  the  electric  field  and  universal 
displacement  current  density  vectors  in  the  frequency  domain  as 

JD(r,f)  -  <x(r,f)  E(r,f)  .  (30) 

Combining  equations  (18),  (21),  and  (30)  yields 

0  (r ,  f )  /  j2rr  f  =  e(r,f)  (31) 

as  the  connection  of  the  universal  displacement  conductivity  and 
the  universal  permittivity  subject  to  the  constraint  that  f  f  O. 
The  convolution  for  universal  displacement  conductivity  becomes 

o(r,f)  -  j  2  Tit  J*  *(r,u)  e+J2Trfu  du  .  (32) 

The*  universal  displacement  conductivity  as  a  complex  number 
can  be  expressed  in  terms  of  its  real  and  imaginary  parts  as 

a(r,f)=<x'(r,f)-ja"(r,f)  (33) 

where  o'(r,f)  and  o"(r,f)  are  respectively  the  real  and  imaginary 
parts.  The  direct  current  (DC)  conductivity  is  the  limiting  case 
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of  the  real  part  of  the  conductivity  when  the  frequency  tends 
toward  zero.  However  the  projected  value  of  DC  conductivity 
becomes  less  distinct  when  nonstatic  measurements  are  made  at 
higher  and  higher  frequencies  especially  over  a  limited 
bandwidth. 

Exploiting  the  identity  posed  by  equation  (31)  yields 

a*  (r ,  f )  =  2?rf  e"  (r ,  f )  (34) 

and 

a" (r , f )  =  2nf  e • (r, f)  .  (35) 

When  a  medium  is  isotropic,  the  displacement  current  density 
JD(r,f)  and  electric  field  E(r,f)  vectors  are  colinear.  In  this 
instance,  the  universal  displacement  conductivity  can  be 
regarded  as  the  scalar  ratio  a(r,f)  of  vectors  given  by 
Jp (r , f ) /E (r , f ) .  If  the  medium  is  anisotropic  or  biref ringent , 
then  one  may  reorient  alongside  a  principal  axis  of  the  local 
conductivity  tensor  to  determine  the  tensor  components.  The  loss 
tangent  defined  in  equation  (25)  becomes 

tan  5(r,f)=a'(r,f)/a"(r,f)  .  (36) 

in  terms  of  the  real  and  complex  conductivity  parts. 

CAUSALITY 

A  physical  response  is  said  to  be  causal  if  it  occurs  at  or 
following  an  excitation.  In  classical  systems  most  responses, 
cannot  anticipate  future  excitations  and  hence  their  connecting 
functions  are  null.  A  partial  relaxation  of  this  behavior  may 
occur  in  quantum  mechanical  systems  wherein  the  connecting 
function  becomes  a  probability.  Quantum  mechanical  causality  or 
other  non-local  overlapping  shall  not  be  dealt  with  in  this 
report.  Both  frequency  domain  universal  dielectric  permittivity 
c(r,f)  and  conductivity  <r(r,f)  arise  from  a  causal  function. 
This  function  is  the  time  domain  normalized  displacement  decay 
current  £(r,u)  or  alternately,  its  accumulation,  the  normalized 
displacement  decay  function  /(r,u).  The  time  variable  u  is  the 
difference  between  present  and  past  times  u  =  t-t ’ .  The  decay 
function  is  a  time  domain  function  and  it  must  be  zero  when  u  is 
negative  (a  non-zerc  value  would  indicate  future  excitations  that 
cannot  have  happened  yet).  The  decay  function  relates  real¬ 
valued  physical  vector  quantities  over  past  history  as  specified 
in  the  convolution  equations  (19)  and  (20).  The  consequence  is 
that  the  decay  function  and  permittivity  are  related  by 
transformation  equation  (23).  The  inverse  relation  that  obtains 
the  decay  function  from  the  permittivity  spectrum  exists  and  is 
required  to  possess  the  aforementioned  physical  constraints..  The 
inversion  procedure  is  accomplished  by  means  of  complex  Laplace 
transforms  or  equivalently  unilateral/one-sided  Fourier 
transforms.  This  procedure  requires  that  the  frequency  be 
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treated  as  a  complex  number  which  can  be  viewed  as  lying  in  the 
complex  frequency  (’s')  plane.  The  complex  frequency  is  defined 
as 


s  =  -j 2vf  .  (37) 

The  substitution  of  the  variable  s  into  equation  (23)  leads  to 
the  alternate  expression  for  the  permittivity 

t(r,s)  =  J®  f(r,u)  e'su  du  (38) 

where  the  other  variables  are  the  same  as  before.  In  Laplace 
transform  operator  notation  equation  (3C)  can  be  succinctly 
written  as 

£(r,s)  =  £(f(r,u))  (39) 

where  £  denotes  the  Laplace  integral  transform  operation 
I  ®  [-••]  e-su  du  acting  upon  f(r,u).  The  inverse  operation  can 
De  obtained  through  residue  theory  and  is 

1  f+c+j°o 

f(r,u)  =  -  e+su  £(r,s)  du  (40) 

2nj  J +c-j° o 

where  the  contour  c  is  chosen  such  that  all  the  singular  points 
of  £(r,s)  lie  to  the  left  of  the  contour  on  the  s-plane.  In 
Laplace  operator  notation  one  can  simply  write  equation  (40)  as 

*(r,u)  =  £_1 ( £ (r , s) )  (41) 

where  £-1  denotes  the  inverse  Laplace  transform  as  given  in  the 
expression  (39). 

The  significance  of  these  transformation  expressions  between 
the  permittivity  and  decay  function  is  that  of  two  important 
properties:  1)  complex  conjugation,  and  2)  analyticity  and 
interdependence  between  real  and  imaginary  parts.  These  two 
properties  are  of  consequence  to  dielectric  observation. 

1)  The  property  of  complex  conjugation  requires  that  the 
permittivity  (as  well  as  conductivity)  become  complex  conjugate 
whenever  the  s-frequency  becomes  conjugate,  i.e. 

€*(r,s)  -  £ (r , s*)  ,  (42) 

where  the  asterisk  superscript  denotes  conjugation  of  the 
preceding  variable.  The  relationship  expressed  by  equation  (42) 
can  be  inferred  by  complex  conjugation  of  the  s-frequency  in  the 
transformation  relations,  (38)  through  (41).  Graphically,  on  the 
s -plane  the  real  parts  of  the  permittivity  and  conductivity 
functions  are  mirror  symmetric  about  the  real  s-axis,  while  the 
imaginary  parts  are  antisymmetric  about  the  real  s-axis.  This 
property  not  only  allows  complex  conjugation  to  occur  between 
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physicists  and  electrical  engineers,  i.e.,  j  =  -i  ,  but  also 
applies  whenever  a  dielectric  permittivity  may  be  made  up  of 
functions  which  are  functions  of  complex  frequency.  This  occurs, 
for  example,  in  the  case  of  composite  mixtures.  Therefore  the 
action  of  applying  composite  mixture  relations  to  well-behaved 
constituents  cannot  introduce  any  violations  of  the  conjugation 
property  in  the  resultant  dielectric  response. 

2)  The  second  property  of  analyticity  and  real/ imaginary  parts 
interdependence  is  commonly  referred  to  as  the  Kramers-Kronig 
relationship  [23,  26-28].  This  relationship  can  be  stated  in 
different  forms  such  as  a  pair  of  complementary  Hilbert 
transforms  or  as  a  pair  of  one-sided  integrals  between  the  real 
and  imaginary  parts  of  permittivity  or  conductivity.  The 
Kramers-Kronig  relationship  is  manifested  in  the  analyticity 
(i.e.,  Cauchy-Riemann  conditions)  and  lack  of  singularities  ot 
the  permittivity  function  on  the  right  side  (positive  s-values, 
real  part)  of  the  s-plane.  If  a  singularity  occurs  on  this 
portion  of  the  s-plane,  then  an  unstable  or  undefined  dielectric 
system  response  would  occur  at  some  range  of  physically 
realizable  excitation  frequencies.  In  order  that  the  decay 
function  f(r,u)  consistently  remains  causal  and  real  valued,  then 
the  singularities  can  only  exist  on  the  left  side  of  the  s-plane 
either  on  the  negative  real  s-axis  or  as  complex  conjugate  pairs 
on  the  left  side  (negative  s-values,  real  part)  of  the  s-plane. 
The  Kramers-Kronig  relation  for  permittivity  may  be  written 

-j  r  «(r,z) 

€(r,s)  =  -  I  -  dz  (43) 

7T  Jc  z-s 

where  the  integral  is  principal  valued  with  the  contour  c  running 
first  along  the  imaginary  s-axis  from  negative  to  positive  then 
clockwise  in  a  large  semicircle  about  the  right  half  s-plane. 
The  variable  z  is  a  variable  of  integration.  Using  the  complex 
conjugation  property  of  equation  (42)  and  reverting  back  to  the 
ordinary  frequency  notation  f,  the  Kramers-Kronig  relation  can  be 
written  as  the  integral  pair 

2  oo  f  '  e  "  ( r ,  f  ' ) 

c'(r,f)  =  -  - - - - -  df'  (44) 

TT  O  (f'2-f2) 

and 

2  f  r«  e'(r,f') 

€"(r,f)  =  -  - - - —  df'  .  (45) 

n  Jo  (f'2-f2) 

Kramers-Kronig  requirements  also  apply  to  composite  mixture 
permittivities  in  that  the  mixing  relations  cannot  introduce 
contradictions  to  well-behaved  constituents. 
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MACROSCOPIC  DIELECTRIC  QUANTITIES 


Both  composite  dielectric  analysis  and  dielectric  data 
acquisition  are  carried  out  over  regions  of  finite  spatial 
extent.  Dielectric  data  acquisition  can  be  a  formidable  task 
because  of  a  limited  ability  to  resolve  the  electric  and 
displacement  field  vector  components,  as  well  as  other 
considerations  such  as  extraneous  polarizations  and  stray  fields. 

Macroscopic  quantities  must  be  introduced  such  that  the 
overall  displacement  flux  remains  continuous.  The  conversion  can 
be  accomplished  in  going  from  the  differential  form  equation  (10) 
(Gauss'  law)  into  an  integral  form  via  the  divergence  theorem  of 
mathematics  as 

Jv  VD(r,t)  dr3  =  Jv  0  dr3  (46) 

and 

j>a  D(r,  t)  -ft  dr2  =  O  .  (47) 

In  equation  (46) ,  the  integration  is  performed  over  the  volume  v 
enclosed  by  a  closed  surface.  In  equation  (47),  the  integration 
is  taken  over  the  surface  enclosing  volume  v,  and  fi  is  the 
outward  drawn  surface  normal  unit  vector.  We  can  conveniently 
restate  equation  (47)  in  terms  of  a  universal  displacement  flux  * 
corresponding  to  the  integrated  displacement  field  passing 
through  a  given  surface.  This  may  be  written  in  the  time  domain 
as 

4>n(t)  =  J  D  (r ,  t)  -ft  dr2  (48) 

or  in  the  frequency  domain  as 

4>n(f  )  =  J  D  (r ,  f )  -fi  dr2  (49) 

with  the  integral  taken  over  the  area  of  the  surface  in  question. 
In  terms  of  displacement  flux  $ ,  the  integral  form  of  equation 
(47)  becomes 

<j>a  d*  (r ,  t )  =  O  (50) 

in  the  time  domain  or 

<fa  d*(r,f)  =  O  (51) 

in  the  frequency  domain.  In  equations  (50)  and  (51),  d$(r,t)  and 
d  * ( r , t )  denote  the  incremental  displacement  flux  as  the 
integration  proceeds  around  the  closed  surface.  The  right  hand 
sides  of  equations  (50)  and  (51)  are  zero  for  this  universal  form 
of  electric  displacement  because  we  have  chosen  the  displacement 
to  be  inclusive  of  all  charges  and  an  overall  charge  neutrality 
exists  within  the  enclosure.  The  units  of  displacement  flux  4> 
are  that  of  charge.  The  time  derivative  of  displacement  flux 
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possesses  units  of  charge  current.  Equations  (50)  and  (51)  are 
thus  simply  a  statement  of  charge/displacement  field  continuity 
and  conservation.  The  interpretation  of  an  electric  displacement 
field  flux  is  that  a  flux  originates  or  terminates  on  a  charge  of 
that  value. 

The  conversion  of  equations  (10)  and  (16)  into  the  integral 
equations  (50)  and  (51)  requires  the  choice  of  some  enclosing 
'Gaussian'  surface.  Generally  this  choice  is  that  of  convenience 
over  which  the  macroscopic  permittivity  e(f)  is  defined.  The 
macroscopic  permittivity  is  defined  in  the  same  sense  as  the 
microscopic  permittivity  of  equations  (21)  and  (22)  with  the 
distinction  that  the  field  quantities  are  mean  valued  over  the 
volume  of  the  enclosure.  The  defining  relation  for  the 
macroscopic  permittivity  tensor  e(f)  becomes 

D  ( f )  =  e (f)  • E ( f )  (52) 

where  D(f)  and  E(f)  are  respectively  the  mean  valued  displacement 
and  electric  fields  over  the  selected  'Gaussian*  enclosure. 
Since  the  permittivity  or  conductivity  is  always  defined  in  the 
context  of  the  frequency  domain,  for  the  remainder  of  this  report 
we  will  drop  the  explicit  frequency  dependence  notation  with  the 
understanding  that  the  frequency  dependence  does  remain.  Thus  in 
this  reduced  shorthand  notation  the  permittivity  e  is 

D  =  e-E  (53) 

where  again  D  and  E  are  respectively  the  displacement  and 
electric  fields  understood  to  be  macroscopic  and  of  the  frequency 
domain.  The  macroscopic  versions  of  other  relevant  dielectric 
relations  are  as  follows: 


i)  The  evolution  from  a  decay  function  corresponding  to 
equation  (23)  is 

€  =  t( u)  efJ2wfu  du  (54) 

where  e  is  the  macroscopic  permittivity  (frequency  dependent)  and 
f(u)  is  the  normalized  macroscopic  displacement  decay  current. 
The  integration  is  performed  over  all  past  times  u  at  fixed 
frequency  f. 


ii)  The  macroscopic  permittivity  is  expressible  in  terms  of  its 
real  and  imaginary  parts  as  in  equation  (24)  as 

€  =  €'  +  j  €"  .  (55) 

iii)  The  loss  tangent  for  the  macroscopic  and  isotropic 
dielectric  specimen  is  the  ratio  of  the  imaginary  to  real 
permittivity  portions 


tan  6  =  e"/€ ' 


(56) 
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a.  s: 


iv)  The  displacement  current  conductivity  in  the  macroscopic 
case  is  found  from  equation  (30)  to  be 

JD  =  a-E  (57) 

here  E  is  the  electric  field  and  JD  =  D/  t  is  the  universal 
isplacement  current  density  at  a  given  frequency. 

v)  The  relation  between  the  macroscopic  permittivity  and 
conductivity  is  found  from  equation  (31)  to  be 

o/j2Tit  =  e  .  (58) 

vi)  The  macroscopic  conductivity  can  be  separated  into  its  real 
and  imaginary  parts  as 

a  =  a*  -  j  au  .  (59) 

vii)  When  the  medium  is  isotropic  with  "espect  to  the 
macroscopic  permittivity,  it  also  must  be  isotropic  in  the 
displacement  conductivity  and  thus  the  loss  tangent  given  by 

tan  S  =  a  '/ a"  (60) 

can  be  found  in  similar  fashion  to  that  of  equation  (36). 

viii)  A  macroscopic  medium  obeys  causality  and  its  behavior  is 
derivable  as  an  analytic  function  through  the  use  of  Laplace 
transform  techniques  upon  the  norma lized  displacement  decay 
current.  In  Laplace  operator  notation  we  can  write 

€ (s)  =  £ (f (u) )  (61) 

where  £  denotes  the  Laplace  integral  transform  operation 
f . . . ]  e-su  du  acting  upon  f(u) . 

ix)  The  complex  conjugation  property  demands  that  a  causal 
analytic  function  which  stems  from  a  real  valued  time  function 

obey 


*  ,  .  ,  * . 
e  (s)  -  € (s  ) 


(62) 


The  complex  conjugation  property  imposes  a  restriction  on  the 
choice  of  composite  mixture  formulae.  Application  of  this 
property  to  the  kth  constituent  species  and  considering  that  the 
composite  response  also  must  be  causal  results  in 


* 

€ 


(63) 


where  e*  is  the  conjugate  permittivity  of  the  composite,  is 
the  conjugate  permittivity  of  the  kth  constituent  species,  and  f 
denotes  some  functional. 


x)  The  Kramers-Kronig  relation  expresses  the  interdependence 
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between  the  real  and  imaginary  parts  as 

~j  r  «(z) 

C  ( s )  =  -  +  -  dz  (64) 

n  Jc  z-s 

where  the  integral  is  principal  valued  with  the  contour  c  running 
first  along  the  imaginary  s-axis  from  negative  to  positive  then 
clockwise  in  a  large  semicircle  about  the  right  half  s-plane. 
The  variable  z  is  a  variable  of  integration.  Such  a  relationship 
is  of  use  in  determining  valid  composite  mixture  formulae  and  for 
checking  authenticity  or  filling  in  data  gaps. 

The  interrelations  expressed  or  implied  in  i)  through  x)  for 
a  macroscopic  dielectric  specimen  are  valid  providing  the 
macroscopic  'Gaussian’  enclosure  boundaries  do  not  change. 

DIELECTRIC  COMPOSITE  MIXTURE  FORMULAE 

Knowledge  of  the  dielectric  characteristics  such  as 
permittivity  for  a  particular  macroscopic  configuration  does  not 
imply  full  knowledge  of  the  subassembly  of  possible  microscopic 
configurations.  This  degeneracy  exists  whenever  a  dielectric 
medium  is  nonuniform  such  as  in  the  case  of  composites.  This 
degeneracy  even  already  exists  for  a  simple  composite  constructed 
of  stratified  flat  layers  with  fixed  constituent  volume 
fractions.  In  this  special  case,  the  solution  can  be  worked  out 
with  treatment  as  a  collection  of  capacitors  aligned  either  in 
series  or  parallel  [4,  29]. 

As  a  consequence,  there  can  exist  a  set  of  composite  mixture 
formulae  which  will  satisfy  or  nearly  satisfy  a  given  particular 
macroscopic  dielectric  observation.  Evidence  of  such  degeneracy 
of  formulae  can  be  found  in  some  of  reviews  on  composite  mixtures 
[25,  30-34].  Moreover,  the  wavelengths  of  the  probing  fields 

typically  applied  in  dielectric  measurements  generally  are  not 
capable  of  resolving  microscopic  features  and  therefore  the 
measured  macroscopic  response  can  only  reflect  collective 
behaviors . 

One  criterion  for  the  applicability  of  a  particular 
composite  mixture  formula  is  that  the  dielectric  response 
predicted  for  a  composite  cannot  introduce  any  new  information, 
particularly  in  regard  to  microscopic  configurations.  In  the 
case  of  random  composites  there  is  by  definition  a  lack  of 
specific  knowledge  of  microscopic  configurations  and  in  order  for 
a  mixture  formula  to  be  of  relevance  it  must  contain  a  minimum  of 
parameters  pertaining  to  the  microscopic  configuration.  The 
composite  dielectric  response  predicted  by  a  mixture  formula  must 
also  reflect  the  same  symmetry  properties  that  are  posed  by  the 
physical  input  situation. 

Two  mixture  formulae  can  be  shown  to  be  particularly 
applicable  to  the  case  of  random  dielectric  composites,  namely 
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Lichtenecker ' s  formula  as  given  in  equation  (1)  and  the  EMT-CPA 
formula  as  given  in  equation  (2).  Each  of  these  two  composite 
mixture  formulae  can  be  explained  with  reference  to  their 
constraints  and  applicability,  as  follows: 

I)  The  Lichtenecker ' s  dielectric  mixture  formula  of 
equation  (1)  is  a  self-similarity  formula  derivable  by  a  process 
of  constraint  elimination  starting  with  a  generalized  expression 
[5,  6].  The  several  constraining  arguments  are: 

1)  Proportionality  and  role  symmetry  must  be  maintained 
between  the  resultant  outcome  and  that  obtained  when  all  the 
constituents  are  changed  by  the  same  common  factor. 
Mathematically  this  may  be  stated  as 

me  =  g [ me 1 , me2 / me 3 ,  .  .  .  ]  (65) 

where  m  is  a  real  multiplicative  factor,  g  means  a  generalized 
functional,  e  is  the  composite  permittivity,  e  j  is  the 
permittivity  of  constituent  species  1,  etc..  The  role  symmetry 
argument  implies  that  no  one  constituent  be  different  than  any 
other  as  far  as  its  contribution  to  the  overall  composite 
dielectric  behavior. 

2)  Mixture  responses  must  be  invariant  with  further  random 
mixing  of  the  type  that  was  employed  in  order  to  attain  its 
present  state.  In  other  words,  if  a  truly  random  state  has  been 
reached  then  further  'stirring'  does  not  affect  the  response  of 
the  composite.  This  property  can  also  be  stated  as  additive 
functional  invariance  to  mixing  by  successive  stages  of  mixtures 
of  mixtures.  This  relation  would  be 

f(«)  -  k  vk  f(€k>  (66) 

where  f  is  a  common  functional,  e  is  the  composite  permittivity, 
is  the  permittivity  of  the  kfc^  const ijfuent  species  occupying  a 
volume  fraction  vk,  and  the  summation  ^  is  over  the  k  species. 
This  property  assumes  that  constituent  volume  densities  are  not 
affected  by  successive  mixing  stages. 

))  The  macroscopic  dielectric  response  must  be  independent 
of  the  sample  size  considered.  This  results  in  the  mixture 
response  being  dependent  on  relative  volume  fractions  and  not 
overall  macroscopic  size. 

4)  The  constituent  volume  densities  must  remain  constant 
during  the  mixing  process.  This  requirement  results  in  the 
additive  relation 


where  vk  is  the  fractional  volume  of  the  kfc^  constituent  species 
in  the  present  stage  of  macroscopic  volume  consideration,  Vj  is 
the  volume  fraction  of  a  submacroscopic  volume  that  goes  intoJthe 
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present  macroscopic  volume,  and  v-  ^  is  the  subvolume  fraction  of 
the  ktn  species  within  the  'submacroscopic  volume.  The 
summation  is  exhaustive  of  all  possible  submacroscopic  volume 
fractions.  Presumably,  the  constituents  cannot  interact  with 
each  other  so  as  to  affect  the  volume  density  of  the  other. 

The  Lichtenecker  mixing  formula  is  a  self-similarity  formula 
of  the  type  found  in  references  [35-38],  meaning  that  regardless 
of  the  macroscopic  size  scale  chosen  for  observation,  one  can 
expect  the  same  result  over  and  over  again.  In  actuality, 
natural  materials  may  only  partially  fulfill  these  requirements, 
especially  if  the  random  mixing  occurs  only  at  a  particular  size 
scale.  Such  a  violation  is  evident  when  considering  molecularly 
interdispei sed  mixtures,  even  when  otherwise  perfectly  randomly 
distributed  with  no  overall  sequential  ordering. 

The  exponential  averaging  factor  a  of  the  Lichtenecker 
mixing  formula  must  be  real  valued  if  the  mixture  is  to  be  causal 
and  obey  the  complex  conjugation  property  as  given  by  equations 
(62)  and  (63).  The  exact  value  of  the  exponential  averaging 
factor  a  has  not  been  entirely  ascertained  for  random  mixtures. 
The  value  of  the  exponential  averaging  factor  must  lie  within  a 
set  of  physical  bounds  called  the  Wiener  bounds.  These  bounds 
require  that  the  exponential  averaging  factor  must  be  real  valued 
at  or  between  minus/plus  unity.  The  value  of  the  exponential 
averaging  factor  that  is  found  in  a  given  random  composite 
configuration  will  depend  on  spatial  degrees  of  freedom  and 
percolation  path(s)  available  to  the  displacement  fluxes  or 
currents  as  they  traverse  the  assortment  of  domain  regions.  If 
the  composite  is  built  up  from  submixtures  all  of  the  same 
exponential  averaging  factor  then  the  composite  has  the  same 
exponential  averaging  factor.  This  then  implies  the  exponential 
averaging  factor  has  a  constant  value  for  a  particular  mixture 
type.  When  the  permittivities  of  the  constituents  are  close  to 
each  other  then  the  exponential  averaging  factor  a  takes  on 
limiting  values  which  tend  to  some  of  the  depolarization  values 
which  are  discussed  next. 

II)  The  e f f ect i ve -med i urn- theory  coherent-potential- 
approximation  (EMT-CPA)  has  been  derived  and  rederived  many  times 
[13-15,  39-42].  This  approximation  is  one  of  the  simpler  of 
effective  medium  theory.  Fundamentally,  its  argument  is  that  a 
domain  region  containing  one  of  the  constituent  permittivities  is 
treated  as  being  surrounded  by  a  medium  whose  effective 
permittivity  is  to  be  determined.  All  other  domains  are  treated 
accordingly  with  the  same  approximation  of  environment.  As  a 
further  approximation  a  certain  domain  geometry  is  presumed,  so 
as  to  lend  to  analytic  solution  of  the  electric  and  displacement 
fields.  The  geometry  selected  is  that  of  ellipsoids,  as  both 
Maxwell's  electromagnetic  equation  set  can  be  solved  using  a 
conformal  coordinate  system  [16,  17],  and  because  this  geometry 
involves  a  minimum  of  structural  detail.  This  treatment 
corresponds  to  the  lowest  order  scattering  of  the  solution  of 
Maxwell's  electromagnetic  equations  in  an  inhomogeneous  media 
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[15,  43].  This  treatment  is  called  the  coherent  potential 

approximation.  A  number  of  other  approximations  and  refinements 
can  be  made  using  the  effective  medium  technique  [32,  44,  45]. 
However,  the  approach  appropriate  to  random  composites  must 
introduce  a  minimum  of  microscopic  detail  and  it  is  felt  the 
coherent  potential  approximation  does  offer  such.  Further 
subtreatments  do  exist  in  so  far  as  different  types  of  randomness 
can  exist  in  composites. 

An  important  factor  which  arises  from  the  effective-medium- 
theory  coherent-potential-approximation  (EMT-CPA)  approach  is  the 
depolarization  factor  'A'.  The  depolarization  factor  'A'  can  be 
calculated  using  an  integral  formula  which  depends  on  the 
ellipsoid  shape  and  is  discussed  in  greater  detail  in  Appendix  A 
[16-18,  32].  In  the  case  of  a  spheroid  situated  in  N  spatial 

dimensions,  the  depolarization  is  simply  the  inverse  of  the 
number  of  spatial  dimensions  (degrees  of  freedom)  as 

A  =  1/N  .  (68) 

When  constituent  permittivities  are  close  valued  with  respect  to 
each  other  then  the  exponential  averaging  factor  can  be  related 
to  the  depolarization  as 

a  -  1  -  2A  .  (69) 

Combining  the  limit  in  equation  (69)  with  the  identity  of 
equation  (68)  yields  the  limiting  parameter  value 

a  >-»  1-2 /N  (70) 

when  the  constituent  permittivity  values  are  close  valued  with 
respect  to  each  other. 

In  this  report  we  treat  both  the  exponential  averaging 
factor  and  depolarization  as  statistical  parametric  values.  Our 
results  are  presented  on  a  parametric  basis  both  in  terms  of  the 
exponential  averaging  factor  'a1  and  the  depolarization  factor 
'A'  for  both  clarity  of  permittivities  on  relative  scales,  and 
presentation  of  complex  numbered  permittivities  in  terms  of  real 
valued  parameters. 

PERCOLATION 

The  term  percolation  refers  to  whether  or  not  there  exists  a 
continuous  connected  path  through  a  constituent  species.  In  the 
context  of  the  dielectric  problem,  percolation  is  whether  or  not 
displacement  flux/current  has  at  least  one  path  through  connected 
domains  of  a  single  constituent  species.  A 

permittivity/conductance  of  zero  blocks  electric  displacement  and 
an  infinite  perm i tt i v i ty / conduct a nee  allows  displacement 
flux/current  to  pass  freely  along  a  path.  The  situation  where 
the  displacement  flux/current  is  in  a  single  constituent  but  not 
the  other  occurs  as  the  limiting  case  where  the  permittivities 
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are  of  infinite  ratio  to  one  another  and  there  exists  a 
percolation  path  amongst  the  larger  permittivity  domains. 

The  Weiner  bounds  (i.e.,  the  series  and  parallel 
stratification  limits  for  dielectric  composites)  can  be  used  to 
represent  the  two  extremes  of  percolation  behavior.  If  the 
constituents  lie  in  flat  layers  with  surface  normals  oriented 
parallel  to  the  applied  electric  field  then  the  exponential 
averaging  factor  as  defined  by  eguation  (1)  takes  on  the  value 
a  =  -1.  If  the  species  lie  in  flat  layers  with  surface  normals 
oriented  perpendicular  to  the  electric  field  then  the  exponential 
averaging  parameter  is  a  =  +1.  For  the  depolarization  as  defined 
by  equation  (2) ,  direct  substitution  of  the  parameter  values  A=1 
and  A=0  give  respectively  the  series  and  parallel  stratification 
limits.  Thus  the  depolarization  is  also  a  measure  of  percolation 
with  respect  to  the  Wiener  bounds. 

Most  often  percolation  is  discussed  in  the  context  of  binary 
mixtures  in  which  one  constituent  is  nonconduct ing  and  the  other 
is  fully  conducting.  It  has  been  found  that  as  the  volume 
fraction  of  the  conducting  constituent  increases,  a  transition 
occurs  once  a  conducting  path  has  been  established  throughout  the 
composite  mixture.  This  transition  is  called  the  percolation 
threshold.  At  the  percolation  threshold,  network  simulations 
with  iso-sized  shuffling  elements  become  self-similar  or 
scaleless  [38].  At  other  constituent  mixing  ratios  this  self¬ 
similarity  may  not  hold.  Li ch tenecker ' s  mixture  formula 
stipulates  that  a  self-similarity  pattern  must  always  be 
maintained  in  a  mixture  type  regardless  of  constituent  mixing 
ratios.  The  network  simulations  used  in  this  report  principally 
employ  iso-sized  shuffling  elements  but  do  not  exhibit  self¬ 
similarity  except  at  percolation  threshoi 

Percolation  mixtures  have  been  extensively  studied  [38,  46, 
47].  It  has  been  found  that  two-dimensional  mixtures  with  a 
random  sputtering  of  iso-sized  grains  have  critical  percolation 
transitions  at  .50  for  bond  cubic  lattices  and  .59  for  site  cubic 
lattices.  Our  studies  of  the  exponential  averaging  factor  tend 
to  confirm  the  percolation  threshold  behavior  for 
conducting/nonconducting  binaries.  At  the  percolation  threshold 
the  Lichtenecker  factor  achieves  its  best  self-similarity  values. 

THE  MACROSCOPIC  SELECTION 

The  'Gaussian'  enclosure  used  in  this  report  is  a 
rectangular  box.  This  choice  lends  itself  to  a  simple 
formulation  for  the  macroscopic  quantities  as  well  as  being  easy 
to  envision  as  a  probe  parallel-plate  capacitor  with  no  fringing 
fields.  The  electric  field  is  applied  between  two  opposite  faces 
of  the  box  contacting  normally  to  these  surface  boundaries.  In 
essence  these  surfaces  form  the  plates  of  the  probe  capacitor. 
The  mean  value  of  the  quasistatic  electric  field  is  normal  to  the 
plate  surfaces  and  has  a  magnitude  of  the  potential  difference 
divided  by  the  gap  distance  separating  the  plates.  In  numerical 
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terms  this  is 


E  =  -V/d  (71) 

where  E  is  the  mean  electric  field  magnitude,  V  is  the  potential 
difference,  and  d  is  the  gap  distance  separating  the  plates.  The 
mean  value  of  the  displacement  field  is  determined  by  the 
displacement  flux  density  averages  passing  through  each  of  the 
three  opposite  face  pairs.  Thus  for  each  face  the  mean 
displacement  field  can  be  written  as 

Dn=  */a  (72) 

where  D  is  the  magnitude  of  the  mean  displacement  field 
component  normal  to  the  face,  $  is  the  displacement  flux  passing 
through  a  face,  and  'a'  is  the  surface  area  of  the  face.  One  of 
the  opposite  face  pairs  are  the  probe  capacitor  plates.  The 
other  two  opposite  face  pairs  are  termed  as  lateral  faces.  The 
permittivity  tensor  can  be  determined  using  equation  (52).  The 
probe  capacitor  may  be  oriented  along  any  direction,  but  for 
convenience  it  may  be  oriented  along  a  principal  axis  whereupon 
the  electric  and  displacement  fields  are  colinear.  In  the 
isotropic  case  the  displacement  and  electric  field  are  always 
colinear  which  implies  that  regardless  of  the  orientation  there 
is  no  lateral  displacement  flux.  We  used  this  fact  as  a  test  of 
isotropy . 

The  experimentalist  may  also  choose  to  use  a  probe 
capacitance  in  the  comparative  sense  in  isotropic  cases.  That  is 

e  =  e0  (C/CQ)  (73) 

where  e  is  the  unknown  permittivity,  eQ  is  the  reference 
permittivity,  C  is  the  measured  capacitance  with  dielectric,  and 
CQ  is  the  reference  capacitance. 

COMPOSITE  DIELECTRIC  STRUCTURE 

A  dielectric  composite  is  a  spatial  aggregation  of 
interspersed  and  interconnected  permittivity  domains.  In  this 
report,  we  seek  to  calculate  the  resultant  macroscopic 
permittivity  of  a  composite  material  for  the  case  of  composites 
which  have  insignificant  quantum  overlap  between  domains.  The 
resultant  permittivity  can  be  analyzed  in  relation  to  that 
predicted  by  the  mixture  formulae  of  equations  (1)  and  (2);  the 
results  of  the  numerical  simulations  will  be  displayed  in  terms 
of  the  exponential  averaging  factor  'a'  and  depolarization  factor 
'A'  . 


The  dielectric  composite  is  solved  in  terms  of  a  pixel-like 
rectangular  grid  as  shown  in  Figure  1.  A  domain  is  made  up  of 
one  or  more  pixels.  Each  pixel  region  is  then  assigned  the 
permittivity  of  the  domain  it  represents.  Each  pixel  experiences 
a  local  electric  field  and  in  turn  responds  with  a  displacement 
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-  material  #1 


-  material  #2 


-  pixel 
boundary 


Figure  1.  Cross-sectional  view  of  the  probe  parallel-plate 
capacitor  'Gaussian'  enclosure  used  in  this  report.  Within  the 
sample  region,  the  composite  dielectric  is  represented  by  a 
rectangular  pixel  arrangement. 


field  as  determined  by  its  assigned  permittivity.  Displacement 
field  continuity  is  preserved  in  passage  amongst  the  pixels.  In 
the  general  case  of  a  random  arrangement  of  domains  there  can  be 
strong  effects  due  to  local  fields  when  the  permittivity 


differences  are  large  between  the  constituents.  Even  though  the 
macroscopic  response  tends  to  wash  out  local  or  microscopic 
details,  these  small  details  seem  to  matter  when  the  mixture  is 
near  percolation  and  the  constituent  permittivity  differences  are 
large.  Because  of  this  effect,  the  numerical  analysis  requires  a 
fairly  high  degree  of  detail  or  one  must  somehow  coyer  the 
crucial  details.  The  approximation  employed  in  this  report  is  a 
method  which  is  sensitive  to  at  least  some  degree  to  local 
effects . 


The  pixels  are  assigned  the  permittivity  value  of  one  of  the 
constituent  materials  in  order  not  to  lend  a  composite  mixing 
bias  to  the  overall  solution,  since  to  assign  a  pixel  a 
permittivity  other  than  one  of  the  constituent  permittivities 
would  require  some  sort  of  assumption  about  possible  composite 
mixing  within  the  pixel  region.  Such  an  assumption  can  only  be 
made  once  some  composite  mixtur  relationship  is  established. 

FINITE  DIFFERENCE  OR  NETWORK  ANALYSIS 


Equations  (10)  a  d  (21)  may  be  solved  simultaneously  and 
macroscop ica  1  ly  to  any  accuracy  ”-~'ng  network  analysis  or 
equivalent .y  finite  difference  approximation.  The  procedure 
involves  the  division  of  the  macroscopic  sample  into  a  mesh  or 
node  set  f  macroscopic  oUbregions.  By  introducing  a  regular 
rectangular  mesh  of  points  {r^}  with  spacings  Sr^  to  contacting 
neighbors  one  obtains  a  system  of  linear  equations  at  each  itn 
mcsh  point  with  contacting  jtn  neighbors 


Z 

j 


or  equivalently 
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=  0 


(74) 


(75) 


where  4  is  the  universal  displacement  flux  and  ID  =  d$/dt  is  the 
universal  displacement  current.  The  summation  is  over  the 
contacting  neighbors  of  the  i*"^  point,  and  mash  points  i  and  j 
contain  the  entire  address  information  needed  to  specify  each 
mesh  point.  The  displacement  flux  and  current  are  each 
determined  by  the  displacement  field  or  displacement  current 
density  normal  to  the  interface  surface  areas  surrounding  each 
mesh  point.  The  determination  of  these  quantities  is  performed 
as  described  previously  in  the  discussion  of  macroscopic 
dielectric  quantities.  Expanding  equations  (74)  and  (75)  one 
obta i ns 
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where  Djj  or  its  time  derivative  dD^^j/dt  =  ID^j 
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(77) 

are  respectively 


the  mean  valued  displacement  field  or  current  normal  to  surface 
(Sa^-j,  and  <5a^j  is  the  surface  area  common  to  the  Gaussian 
enclosures  between  the  ith  and  nodes.  The  local  displacement 
field  may  be  related  to  the  local  electric  field  as 


TO 


-  £ij  Eij 


(73) 


where  D^j  and  are  the  mean  valued  displacement  and  electric 
fields  on  the  interface  between  the  ith  and  nodes,  and  is 
the  permittivity  characteristic  between  the  ith  and  noaes. 
The  mean  electric  field  can  be  expressed  quas istat ica 1 ly  as  a 
potential  difference 


Eij  =  SV^/6r^  (7-0 

where  E^-:  is  the  mean  electric  field,  <SV^-  =  (V--V^)  is  the 
potential  difference  between  nodes,  and  6r ■  =  jir--r^|  is  the 
internodal  separation.  The  potential  or  voltage  at  "the  ith  mesh 
node  point  is  denoted  as  V The  electric  field  E^  is  the 
component  in  the  direction  perpendicular  to  the  interface  shared 
commonly  between  the  ith  and  nodes.  Since  rectangular  boxes 

are  selected  in  this  report  as  the  type  of  macroscopic  enclosure, 
the  surface  normal  direction  lies  along  the  same  direction  as  the 
internode  gaps  5rij  when  the  nodes  are  placed  at  the  box  centers. 
Substituting  the  ^equations  (78)  and  (79)  into  equation  (76) 
produces  at  each  ith  node  the  sum  over  the  neighbors 

j  ( e  i  j  6Vi  j  Ja^/Jr^  =  O  (80) 

where  the  notations  are  as  before.  The  potential  drops,  5V  —  - 
( V j -V ^ ) ,  are  the  unknowns  in  a  system  of  simultaneous  equations 
formed  when  all  nodes  are  taken  together  with  an  exciting 
electric  field  or  potential  applied  across  the  probe.  The 
factors  other  than  the  potential  drops  in  equation  (80)  may  be 
combined  into  a  set  of  internodal  admittances,  yielding 

5  «Jij  {Vij  =  °  <81> 

with  the  internodal  admittances  just  g^j  =  (e^j  <5a|  j  /  6r  ^  j )  . 

The  arguments  made  in  equations  (78)  through  (81)  can  be 
repeated  in  a  parallel  fashion  with  the  universal  displacement 
current  and  universal  displacement  conductivity.  One  may  view 
this  application  of  Gauss'  law  as  an  integral  formalism  embodied 
by  Kirchoff's  rules  for  a  universal  displacement  current.  Each 
node  within  the  mesh  represents  a  small  'Gaussian'  enclosure. 
The  rules  of  displacement  flux/current  continuity  are  then 
applied  to  the  boundaries  between  contacting  nodes  [37,  48,  49]. 


BOND  OR  SITE  CENTERED  PIXEL  PERCOLATION  APPROXIMATIONS 


The  generalized  path  admittance  characteristics  g^j  as  given 
by  equation  (81)  may  be  assigned  on  the  basis  of  two  pixel 
percolation  approximations  as  illustrated  in  Figure  2:  1)  site 
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a)  Each  path  linking  adjoining  nodes  in  the  site  pixel 
percolation  approximation  straddles  two  pixel  cell  regions. 
Since  a  single  constituent  permittivity  is  assigned  to  each 
pixel,  the  admittance  characteristic  of  the  path  is  the  series 
combination  of  the  permittivities  of  both  regions. 
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b)  In  the  bond  pixel  percolation  approximation  each 
displacement  flux/current  path  resides  within  a  single  pixel  cell 
region.  The  path  is  assigned  the  admittance  characteristic  of 
the  permittivity  of  the  pixel  cell. 

Figure  2.  Site  (a)  and  bond  (b)  pixel  percolation 

approximations.  [  o  o  o  ]  designates  the  pixel  cell  boundary, 

[  b  a  a  j  outlines  a  possible  displacement  flux/current  path,  and 
a  [  •  ]  denotes  a  node  where  paths  meet. 


centered  pixels  and  2)  bond  centered  pixels.  In  both  instances, 
simulations  yield  similar  trends  in  the  results  with  some 
background  changes  in  the  overall  percolation. 

1)  The  pixel  permittivity/conductivity  assignment  method  in  the 
case  of  site  centered  pixels  is  to  assign  each  mesh  node  region 
to  a  pixel.  In  the  site  representation  the  internodal  paths  have 
two  consecutive  admittances/conductances  which  are  treated  as  a 
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series  combination. 


2)  The  permittivity/conductivity  assignments  for  the  case  of 
bond  centered  pixels  are  that  each  internodal  path  represents  a 
pixel  characteristic .  Since  each  pixel  has  been  assigned  only 
one  of  the  constituent  characteristics,  each  path  is  not  a 
combination  of  properties. 

Both  types  of  arrangements  are  discussed  in  the  literature 
on  percolation  problems  [37,  46,  47,  49]. 

LATERAL  BOUNDARY  CONDITIONS 

The  overall  rectangular  node  mesh  representing  a  dielectric 
composite  specimen  is  solved  with  exciting  electrodes  or  ’plates’ 
placed  in  contact  with  the  opposite  faces.  Continuity  of  the 
displacement  field  requires  that  the  same  amount  of  displacement 
flux/current  which  begins  on  one  plate  terminates  on  the  other 
plate.  This  displacement  flux/current  boundary  condition  is 
satisfied  at  the  plates  when  the  exciting  field  is  solved 
together  with  equation  (81) .  This  leaves  an  open  question  as  to 
how  to  handle  the  displacement  flux/current  on  the  other 
(lateral)  faces  formed  by  the  rectangular  mesh  that  has  been 
superimposed  on  the  dielectric  specimen.  The  displacement 
flux/current  could  still  enter  and  exit  at  the  other  faces  so 
long  as  the  overall  quantity  is  conserved.  As  illustrated  in 
Figure  3,  two  types  of  lateral  boundary  conditions  are 
implemented  here. 

The  first  and  simplest  condition  is  that  of  'insulating' 
faces,  wherein  we  consider  the  dielectric  specimen  to  be 
electrically  isolated  or  'guarded'  along  the  lateral  boundaries. 
In  this  instance  at  the  lateral  boundaries,  the  normal  component 
of  the  displacement  field  approaches  zero  as  no  displacement  flux 
can  leave  the  specimen.  The  'insulating'  boundary  condition  can 
be  imposed  exactly  with  the  computer  model  although  in  physical 
reality  this  is  more  difficult  to  dc  because  of  the  effect  of 
fringing  fields.  This  condition  can  be  implemented  through 
equation  (81)  by  having  the  lateral  mesh  nodes  interact  only  with 
adjacent  interior  mesh  nodes.  The  'insulating'  boundary 
condition  is  applicable  to  isolated  specimen  samples  or  lattice 
cells  with  mirror  symmetries  and  planes.  For  example,  an 
ellipsoid  has  symmetry  planes  between  each  pair  of  semi-axes,  and 
the  solution  for  an  octant  of  the  ellipsoid  is  also  the  solution 
for  a  cubic  repeating  lattice  of  ellipsoids  with  the  same 
repeating  symmetry  boundaries. 

A  second  type  of  boundary  condition  is  that  of  'periodic' 
boundaries  in  which  the  specimen  represents  a  repeated  cell  in  a 
cyclic  lattice  structure.  In  this  case  the  magnitude  of  the 
normal  component  of  the  displacement  field  is  the  same  at  similar 
locations  on  opposite  lateral  faces.  In  some  cases  either 
boundary  condition  can  be  used  on  the  same  problem. 
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D||  (a)  f  D ||  (b)  f  O  D||(a)  =  Dg  (b)  f  O 


Dj.(a)  =  D±(b)  =  O  Dj_(a)  =  Dj_(b)  =  O 


Figure  3.  Lateral  boundary  conditions  on  the  composite 
dielectric.  'Insulating'  means  that  no  displacement  flux/current 
enters  or  exits  the  lateral  faces.  'Periodic'  means  that 
entering  or  escaping  flux/current  on  a  lateral  face  must  enter  at 
a  similar  location  on  the  opposite  lateral  face  such  that  overall 
displacement  flux/current  conservation  is  maintained. 


In  the  case  of  random  isotropic  media  the  lateral 
displacement  field  becomes  a  vanishingly  small  statistical 
fluctuation  and  the  choice  between  either  set  of  boundary 
conditions  has  little  effect  on  the  overall  solution.  If  the 
distribution  of  dielectric  constituents  is  not  uniformly  random 
but  shows  an  overall  anisotropy,  a  lateral  displacement 
flux/current  may  occur  and  the  macroscopic  permittivity  will  be 
nonuniformly  tensored. 

SOLUTION  AND  COMPUTER  IMPLEMENTATION  OF  THE  NETWORK 

'['he  mesh  approximation  is  equivalent  to  an  electrical 
network  or  a  finite  difference  grid  scheme.  The  nodes  are  the 
intersections  between  displacement  flux/current  paths.  The 
electrical  elements  are  the  displacement  flux/current  path 
admittances  between  the  nodes.  The  N  nodes  infer  that  there  are 
N  simultaneous  node  equations  plus  one  for  the  exciting  node.  An 
important  prerequisite  to  solving  this  set  of  N+l  simultaneous 
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equations  is  the  choice  of  a  numbering  scheme.  In  the  scheme 
adopted  here,  the  nodes  are  numbered  sequentially  from  the  ground 
electrode  and  in  relation  to  (x,y,z)  coordinate  location.  The 
1  h  node  number  is 

i  =  x  +  (y-1 )  Xm  +  (z-1)  Xm  Ym  (82) 

where  (x,y,z)  are  integers  in  the  range  (l..Xm,  l..Ym,  1..Z  ). 
The  node  address  may  be  specified  by  the  node  number  i  or  by  the 
coordinates  (x,y,z).  The  values  X  ,  Y^,  and  Zm  are  the  extents 
of  the  rectangular  mesh  array  in  each  direction. 

The  N+l  simultaneous  node  equations  are  solved  directly  and 
methodically  by  means  of  Gauss-Seidal  elimination,  a  plodding  but 
sure  fire  technique  which  can  be  adapted  to  the  mathematics  of 
complex  numbers.  Back  substitution  may  be  invoked  to  double 
check  the  consistency  of  a  numerical  solution.  By  solving  the 
node  equations  in  a  sequence  that  roughly  follows  the  order  of 
the  expected  node  potentials  (i.e.,  the  solution  is  worked  from 
the  ground  potential  up),  one  can  minimize  the  buildup  of 
truncation  errors.  The  neighbor  nodes  of  the  boundary  nodes  wrap 
around  to  the  opposite  lateral  face  in  the  case  of  periodic  or 
cyclic  boundary  conditions. 

INTERACTION  MATRIX 

The  set  of  N  +  1  mesh  equations  as  formed  from  equation  (81) 
can  be  cast  into  a  matrix  form.  The  elements  of  this  matrix  are 
the  interactions  between  nodes.  The  elements  along  the  main 
diagonal  of  the  matrix  are  self-interact ion  terms  corresponding 
to  the  sum  of  all  admittance  paths  connecting  to  a  node.  The 
other  elements  are  the  neighbor  interactions.  When  the 
neighboring  node  directly  adjoins,  the  corresponding  matrix 
element  is  the  negative  admittance  of  the  path.  When  the  nodes 
are  not  directly  joined  by  a  single  bond  path,  the  matrix  element 
is  zero.  The  matrix  formalism  is  convenient  because  many 
standard  mathematics  packages  have  libraries  and  function 
capabilities  for  matrix  operations.  The  set  of  equations  in 
matrix  form  may  be  written 

{*}  =  {g}  {V}  (81) 

where  {*}  is  a  column  matrix  whose  elements  are  the  total 
displacement  flux  at  each  node.  According  to  the  continuity 
requirement,  all  elements  of  {$}  are  zero  except  that  of  the 
exciting  flux.  (V)  is  a  column  matrix  whose  elements  are  the 
node  potentials  and  {g}  is  a  matrix  representing  the  admittance 
interactions  between  nodes.  The  admittance  matrix  (g)  is 
symmetric  and  most  off-diagonal  elements  are  zero  as  they 
represent  interactions  between  pairs  of  other  than  nearest 
neighbor  nodes.  (Classical  rules  of  electromagnetism  do  not  allow 
flux  to  jump  from  one  region  of  space  to  another  without  an 
intervening  path,  thus  interactions  occur  only  between  adjoining 
node  pairs.)  The  quantum  mechanical  formalism  does  allow  for 
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nonlocal  jumping  of  displacement  flux/current  and  hence  more  non¬ 
zero  terms  in  the  admittance  matrix;  however,  in  this  report  we 
will  only  deal  with  the  classical  case. 

In  the  sparse  symmetric  matrix  case  examined  here,  a 
judicious  Gauss-Seidal  elimination  progression  proved  to  be 
substantially  faster  than  full  matrix  inversion,  especially  when 
the  N+l  equations  become  large.  Equation  (82)  tells  us  that  the 
maximum  node  number  is  the  mesh  box  size  which  is 
N+l  =  (Xm  Ym  Zm)+l.  The  number  of  non-zero  terms  in  any  row  is 
only  the  number  of  neighbors  in  actual  contact.  By  selecting  a 
node  numbering  scheme  as  compact  as  possible  between  neighbors  it 
is  possible  to  solve  the  matrix  with  a  minimum  of  memory  space 
and  computer  operation.  The  solution  time  for  the  procedure 
implemented  here  went  roughly  as  the  square  of  the  admittance 
interaction  matrix  size  N+l.  This  allowed  simulations  of  pixels 
and  their  mesh  networks  of  up  to  about  40x40  in  two  dimensions 
and  12x12x12  in  three  dimensions. 

The  exponential  averaging  factor  'a'  is  computed  by 
iteration  of  equation  (1)  until  a  consistent  solution  is  reached 
between  the  resultant  and  constituent  permittivities.  The 
depolarization  factor  'A'  for  binary  composites  can  be  solved 
from  a  quadratic  solution  of  equation  (2).  The  depolarization 
factor  for  composites  having  more  than  two  constituents  must  be 
solved  iteratively  until  a  self-consistent  solution  of  equation 
(2)  is  obtained. 

VERIFICATION  OF  NUMERICAL  SOLUTION 

The  numerical  analysis  has  been  implemented  using  the 
Hewlett-Packard  HP  Basic/UX  6.0  programming  language,  also  known 
as  Poc^y  Mountain  Basic.  This  language  follows  the  IEEE  Std  754- 
1085  lor  binary  numbers.  The  code  is  run  on  an  HP  9000  Series 
i o o  workstation  with  a  machine  precision  of  8  bytes  for  real 
numbers  and  16  bytes  for  complex  numbers.  The  precision  for 
complex  numbers  equates  to  a  precision  in  the  mantissa  of  about 
one  part  in  lO15.  The  accuracy  of  the  numerical  solution  has 
been  tested  in  several  ways. 

The  tirst  and  most  obvious  test  was  the  calculation  of  the 
macroscopic  response  of  a  sequence  of  layers  with  surface  normals 
either  aligned  along  or  normal  to  the  electric  field  direction. 
This  could  be  accomplished  by  randomizing  selectively  on 
successively  the  k,  and  2  axes.  No  deviations  from  the 
expected  limiting  Wiener  Bounds  were  found  to  occur  other  than 
truncation  errors  in  the  lowest  few  mantissa  bits.  A  second  test 
was  to  examine  the  stability  of  a  given  composite  layout  as  it 
was  enlarged  or  symmetrically  folded  into  another  pixel  size. 
Since  the  physical  problem  is  still  the  same  in  the  symmetrical 
sense,  then  the  expected  solution  cannot  vary.  The  observed 
results  were  consistent  with  our  expectations. 

We  had  two  methods  of  matrix  inversion  available  in  solving 


the  nodal  analysis.  One  was  the  intrinsic  matrix  inversion  built 
into  the  HP  Basic  language  and  the  other  was  the  tailored  sparse- 
advantaged  Gauss-Siedal  elimination  that  we  developed  for  the 
program.  The  two  methods  agreed  with  each  other  to  within 
machine  precision.  Furthermore,  in  either  mode  the  solutions 
could  be  checked  by  back  substitution  comparison  to  the  original 
problem.  We  found  errors  no  worse  than  in  the  lowest  two  or 
three  mantissa  bits. 


RESULTS 

The  results  of  our  work  are  displayed  in  Figures  4  through 
31.  Both  the  exponential  averaging  factor  'a'  and  the 
depolarization  factor  'A'  are  displayed  as  the  volume  fraction  ot 
the  constituents  is  changed.  Both  the  exponential  averaging 
factor  'a'  and  the  depolarization  factor  'A'  are  real  numbers  (as 
opposed  to  complex  numbers)  in  causal  systems,  even  when  the 
permittivities  of  the  constituents  are  complex.  This  fact 
provides  an  additional  simplification  of  the  results.  In  Figures 
6  through  27,  the  real  part  of  the  averaging  factor  of  interest 
is  denoted  with  a  (+)  and  the  imaginary  part  with  a  (-)  on  the 
graphs.  The  imaginary  part  remains  near  zero  (as  expected)  and 
tends  to  fluctuate  markedly  less  than  its  real  counterpart. 

Figures  4  and  5  show  respectively  the  resultant  permittivity 
versus  constituent  volume  for  isotropic  binary  composites  of 
£l=l,  e2=2  anc*  ei=1'  e2=10.  In  each  case  the  Wiener  bounds  are 
drawn  along  with  several  curves  at  equidistant  spacings  of 
exponential  averaging  and  depolarization  factors.  For  the  case 
of  nearly  equal  constituent  permittivities  as  shown  in  Figure  4, 
the  exponential  averaging  and  depolarization  curves  are  nearly 
indistinguishable.  For  larger  permittivity  differences  as  shown 
in  Figure  5,  the  two  formulae  yield  distinctly  different  results. 
In  these  figures,  the  permittivity  is  displayed  directly  to 
demonstrate  that  data  can  be  presented  in  this  way,  but  the 
curves  are  squeezed  at  the  ends  and  lie  within  a  banana-shaped 
envelope.  With  complex  permittivities  of  real  and  lossy  parts 
the  data  become  even  more  difficult  to  display.  Subsequent 
figures  are  thus  presented  by  exponential  averaging  and 
depolarization  factor  windows  whose  abscissa  limits  are  the 
Wiener  bounds  and  whose  ordinate  limits  are  the  minimum  and 
maximum  possible  constituent  volume  fractions. 

A  number  of  cases  are  examined  and  displayed  in  terms  of  the 
exponential  averaging  and  depolarization  windows.  The  first  case 
shown  in  Figures  6  and  7  is  that  of  three-dimensional  spheres 
spaced  in  an  infinite  cubic  lattice.  For  small  volume  fraction 
of  spheres,  this  case  corresponds  correctly  to  the  far  field 
limit  of  the  depolarization  expected  for  dielectric  spheres 
embedded  within  a  host.  However,  as  the  volume  fraction  ot  the 
spheres  increases ,  near  field  changes  occur  and  the 
depolarization  departs  from  the  far  field  approximation. 
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Figures  8  through  27  present  various  Monte  Carlo  simulations 
both  in  two  and  three  dimensions.  The  two-dimensional  cases  in 
Figures  8  through  13  are  complex  valued  extensions  of  real-valued 
analyses  from  the  earlier  work  [50].  The  numerical  permittivity 
simulations  have  been  carried  out  with  both  bond  and  site 
centered  pixel  arrangements. 

There  generally  can  be  a  multitude  of  constituent  grain 
shapes  for  various  heterogeneous  composites  or  mixtures  that  can 
be  modeled.  The  simplest  possibility  is  a  random  shuffling  of 
iso-sized  constituent  grains.  The  iso-sized  grain  case  would 
probably  best  correspond  with  molecular  mixing  without  the 
chemical  and  quantum  interactions.  In  geology,  'sandy' 
composites  or  iso-sized  conglomerates  could  be  examples.  The 
iso-sized  constituent  grain  model  is  mainly  what  has  been 
approximated  by  our  network  models  in  Figures  8  through  23. 
Another  likely  possibility  is  a  composite  in  which  there  is  a 
range  of  constituent  grain  sizes  randomly  shuffled.  A  'marbled' 
mixture  would  have  some  distribution  of  assorted  constituent 
grain  sizes.  Many  natural  composites  exhibit  this  feature  to 
some  degree.  Figures  24  through  27  show  network  simulations 
where  a  preliminary  effort  has  been  made  to  include  a  limited 
range  of  constituent  grain  sizes.  Our  results  indicate  >n 
increased  scatter  which  is  due  to  the  additional  fluctuations 
induced  by  having  the  larger  grains  present.  Also  our  results 
still  closely  approximate  the  iso-sized  case  in  that  the 
effective  medium  or  depolarization  factor  'A'  is  mostly  constant. 
The  calculated  values  of  Lichtenecker ' s  factor  'a'  would  remain 
more  constant  if  the  same  self-similarity  pattern  were  maintained 
over  a  composite  sample  which  is  much  larger  than  the  largest 
constituent  grain.  Obviously  our  network  simulations  are  very 
limited  in  this  respect.  Only  near  the  percolation  threshold 
transition  is  the  self-similarity  aspect  primarily  evident  in  the 
grain  layout  of  the  iso-sized  shuffling  case  [38],  In  the  even- 
numbered  Figures  8  through  26  the  percolation  is  approximately 
marked  at  the  centers  of  transition  in  the  'a'-factor. 

Indications  from  the  numerical  simulations  are  that  both  the 
exponential  averaging  factor  'a'  and  the  depolarization  factor 
'A'  are  nearly  congruent  for  representing  the  resultant  permit¬ 
tivity  of  composite  mixtures  where  the  constituent  permittivities 
differ  by  less  than  a  factor  of  two  such  as  in  Figures  14  and  15. 
When  the  constituent  permittivities  differ  by  more  than  a  factor 
of  two,  the  exponential  averaging  factor  and  depolarization 
factor  diverge  according  to  the  mixture  type.  This  is  evident  in 
the  Figures  8  through  13  and  16  through  27.  The  implication  is 
that  the  resultant  permittivity  is  dependent  on  the  randomness 
type  involved  in  the  composite,  such  as  whether  the  constituent 
grains  are  iso-sized  or  have  a  self-similar  range  of  assorted 
r,  i  zer, . 
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FAMILY  OF  PERM  I TT IU I T Y  CURUES 


C  Bounds  -  3  C  EMA  -  —  3  C  A  I  pKa  * - 3 


Figure  4.  Permittivity  curves  at  ratio  6,/e^lO.  The  curves 
situated  between  the  Wiener  bounds  are  equally  spaced  in  a  and  A 
ranges  respectively.  (a=-.50f  A=.75,  a=.0,  A=.50,  a=.SO,  A=.25) 
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C  -  3  L  EM P  —  —  3  C  A  i  pKa  - - 3 

Figure  5.  Permittivity  curves  at  ratio  e^/^^lOO.  As  ,lt>ove  the 
curves  are  equally  spaced.  Note  that  the  bounds  envelope  expands 
and  each  curve  pair  is  less  coincident  for  the  larger  ratio. 
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COMPLEX  RANDOM  3D  NETUORKS 


Figure  6.  Cubic  l.  ccice  of  spheres  with  permittivity  (1,1000) 
embedded  within  a  ,ost  of  permittivity  (1,0),  a-windowed.  Note 
the  percolatic  .  ump  which  occurs  when  spheres  make  contact  at 
closest  packing.  Resolution  20x20x20  per  cell. 
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Figure  7.  Cubic  lattice  of  spheres  with  permittivity  (1,1000) 
embedded  within  a  host  of  permittivity  (1,0),  A-windowed.  The 
depolarization  matches  the  expected  far  field  limit  values  at  the 
ends  of  the  volume  packing  range. 
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Figure  8.  Two-dimensional  composite  mixture,  a-windowed, 
constituent  permittivities  of  €^=(1,0)  and  e2=(0,100).  Each 
or  connecting  path  is  randomly  assigned  one  of 
permittivities. 
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Figure  9.  Two-dimensional  composite  mixture,  A-windowed, 
constituent  permittivities  of  €1={1,0)  and  62=  (O,  !! OO)  .  Each 
or  connecting  path  is  randomly  assigned  one  of 
permittivities. 
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Figure  10.  Two-dimensional  composite  mixture,  a-windowed,  with 
constituent  permittivities  of  e1=(l,0)  and  e2=(°»1000)*  Each  bond 
or  connecting  path  is  randomly  assigned  one  of  the 
permittivities.  Resolution  size  at  40x40  bonds. 
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Figure  11.  Two-dimensional  composite  mixture,  A-windowed,  with 
constituent  permittivities  of  €^=(1,0)  and  e 2= (° » lOOO) .  Each 
bond  or  connecting  path  is  randomly  assigned  one  of  the 
permittivities. 
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Figure  12.  Two-dimensional  composite  mixture  with  constituent 
permittivities  of  £^(1,0)  and  e2=(0,100),  a-windowed.  Each  site 
or  path  cluster  surrounding  a  node  is  randomly  assigned  one  of 
the  permittivities.  Resolution  or  network  size  is  20x20  sites. 
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Figure  13.  Two-dimensional  composite  mixture  with  constituent 
permittivities  of  £^=(1,0)  and  £2=(0,10C),  A-windowed.  Each  bond 
or  node  cluster  is  randomly  assigned  one  of  the  permittivities. 
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Figure  14.  Three-dimensional  composite  mixture  with  constituent 
permittivities  of  e1=(l,0)  and  e2=(l,l),  a-windowed.  Each  site 
or  node  cluster  is  randomly  assigned  one  of  the  permittivities. 
Resolution  size  at  10x10x10  bonds. 
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Figure  15.  Three-dimensional  composite  mixture  with  constituent 
permittivities  of  e1=(l,0)  and  e2=(1»1)»  A-windowed.  Both  'a' 
and  A'  curves  are  nearly  coincident  in  permittivity  between  the 
Wiener  Bounds. 
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Figure  16.  Three-dimensional  composite  mixture,  a-windowed, 
with  constituent  permittivities  of  e1=(l,0)  and  e2=(1»1°) 
randomly  shuffled  in  a  site  grid,  10x10x10.  Ratio  of  c2/6i 
(1,10)/ (1,0)=(1,10) . 
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Figure  17.  Three-dimensional  composite  mixture,  A-windowed, 
with  constituent  permittivities  of  €,=(1,0)  and  e,-(l, 10) 
randomly  shuffled  in  a  site  grid,  10x10x10.  Insulated  boundary 
conditions  apply.  The  depolarization  remains  at  about  .5. 
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Figure  18.  Three-dimensional  composite  mixture,  a-windowed, 
with  constituent  permittivities  of  €^=(1,0)  and  e2=(l,100) 
randomly  shuffled  in  a  site  grid,  10x10x10. 
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Figure  19.  Three-dimensional  composite  mixture,  A-windowed, 
with  constituent  permittivities  of  €^=(1,0)  and  e2=(l,100) 
randomly  shuffled  in  a  site  grid,  10x10x10.  The  depolarization 
slightly  deforms  with  a  minimum  around  the  percolation  threshold. 
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Figure  20.  Three-dimensional  composite  mixture,  a-windowed, 
with  constituent  permittivities  of  e,=(l,0)  and  e2=(l,1000) 
randomly  shuffled  in  a  site  grid,  10x10x10.  Insulated  lateral 
boundary  conditions  apply. 
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Figure  21.  Three-dimensional  composite  mixture,  A-windowed, 
with  constituent  permittivities  of  e1=(l,0)  and  e2=(l,1000) 
randomly  shuffled  in  a  site  grid,  10x10x10.  The  depolarization 
deforms  with  a  minimum  around  the  percolation  threshold. 
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Figure  22.  Three-dimensional  composite  mixture,  a-windowed, 
with  constituent  permittivities  of  £.=(1,0)  and  e2=(l,1000) 
randomly  shuffled  in  a  site  grid,  10x10x10,  with  periodic 
boundary  conditions. 
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Figure  23.  Three-dimensional  composite  mixture,  A-windowed, 
with  constituent  permittivities  of  €.=(1,0)  and  e2=(l,1000) 
randomly  shuffled  in  a  site  grid,  10x10x10,  with  periodic 
boundary  conditions.  The  change  from  insulated  to  periodic 
boundary  conditions  has  little  effect  on  this  random  case. 


39 


COMPLEX  RANDOM  3D  NETUORKS 


Uo I ume  fract i on 


Figure  24.  Three-dimensional  composite  simulation  with  8x8x8 
sites,  a-windowed,  with  permittivities  e1=(l,0)  and  e2=(0,l000). 
Each  size  stage  2x2x2,  4x4x4,  and  8x8x8  is  randomly  scaled  and 
shuffled. 


COMPLEX  RANDOM  3D  NETUORKS 


Uo I ume  fract i on 


Figure  2^.  Three-dimensional  composite  simulation  with  8x8x8 
sites,  A-windowed,  with  permittivities  €^(1,0)  and  e2=(0,1000). 
Each  size  stage  2x2x2,  4x4x4,  and  8x8x8  is  randomly  scaled  and 
shuffled.  Note  that  the  random  composites  grains  have  more 
scatter  as  a  result  of  the  wider  size  distribution. 
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Figure  26.  Three-dimensional  composite  simulation  with  8x8x8 
sites,  a-windowed,  with  permittivities  £.^=(1,0)  and  e2=(0,109). 
Fach  size  stage  2x2x2,  4x4x4,  and  8x8x8  is  randomly  scaled  and 
shuf  fled. 
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Figure  27.  Three-dimensional  composite  simulation  with  8x8x8 
sites,  a-windowed,  with  permittivities  €^=(1,0)  and  e2=(0,109). 
E.ich  size  stage  2x2x2,  4x4x4,  and  8x8x8  is  randomly  scaled  and 
shuffled.  Even  at  this  large  ratio  of  permittivities,  back 
substitution  revealed  little  error. 
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Figure  32.  Run  times  for  two-dimensional  s: 
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FUTURE  WORK 


The  completion  of  the  design  and  computer  coding  for  the 
bond  and  site  models  for  composite  dielectrics  opens  up  a  large 
range  of  research  possibilities.  Future  work  should  include: 

a)  Analysis  of  composites  with  three  or  more  components . 
Studies  allowing  mixture  formulae  to  be  employed  within  the 
pixels  in  a  fashion  self-consistent  with  the  overall  composite 
solution . 

b)  Studies  of  the  mapping  of  the  displacement  field  and  the 
electric  field  within  specimens. 

c)  Extension  to  cases  of  dyadic  or  tensorial  permittivity 
constituents  and  composite  dielectric  response. 

d)  Study  of  fractal  and  self-similar  composites  especially 
random  fractals  and  scaling  of  percolation.  Fractal 
dimensionality  and  spatial  correlation  layout  measurements  would 
reflect  the  degree  of  self-similarity  and  also  allow  spectral 
dimensionality  considerations. 

e)  Investigation  of  the  Maxwel 1-Wagner  effect  over  different 
types  of  composite  mixtures. 

f)  Development  of  engineering  design  code,  tables,  and 
approximations  which  make  these  composite  mixture  formulae  easily 

accessible . 

g)  Extension  to  pole-zero  analysis  and  design  of  artificial 
dielectrics  as  well  as  the  utilization  of  the  Kramers-Kronig 
relations  for  cross-checking  laboratory  data  as  to  causality  or 
the  interpolation  and  smoothing  of  partial  data  gaps.  Examination 
of  the  relationship  between  our  network  studies  and  the  phenomena 
of  universal  type  of  frequency  dependence  in  ponderable 
dielectric  properties  as  exhibited  by  many  substances. 

h)  Studies  of  stretched,  elongated,  and  stratified  composites. 

i)  Studies  of  quantum  overlap,  quantum  sensitive,  and  non-local 
ef  f ects . 
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APPENDIX  A.  Depolarization 


The  resultant  permittivity  of  a  dielectric  ellipsoid  of  one 
permittivity  embedded  in  a  medium  of  another  permittivity  can  be 
determined  by  solving  Laplace's  equation  within  each  of  the  media 
using  confocal  ellipsoidal  harmonics  [16-18,  30,  31,  51-55].  The 
solutions  for  the  two  regions  are  then  matched  at  the  dielectric 
interface  according  to  the  boundary  conditions  of  continuity  of 
the  normal  component  of  the  electric  displacement  field  and 
continuity  of  the  tangential  component  of  the  electric  field.  A 
geometric  factor  related  to  the  ellipsoid  shape  which  emerges 
from  the  solution  is 


A 


P 


abc  oo  du 
2  Jo  R  (u+p2) 


(p=a,b,c) 


where  a,  b,  and  c  are  the  ellipsoid  axes  and  A  is  the  depolari¬ 
zation  factor  when  the  overall  fields  are  aligned  along  an  axis. 
Accordingly,  within  the  integral  p  assumes  the  value  of  a,  b,  or 
c.  The  function  R  is  defined  by  positive  R2 

(x+a  ) (x+b2) (x+c2) .  Integration  by  parts  yields  the  identity 
A  +Afc+Ac  =  1.  Thus  the  relation  for  the  case  a=b=c  is  A  =1/3. 
Tne  two-dimensional  case  is  obtained  by  examining  the  limit  as 
one  of  the  ellipse  axes  goes  to  infinity  so  as  to  effectively 
eliminate  it  from  the  integral.  Thus  in  the  two-dimensional  case 
the  identity  is  Aa+A^  =  1  and  for  a=b  we  have  A  =  1/2.  The  same 
procedure  can  be  applied  to  solve  the  one-dimensional  case  giving 
the  trivial  solution  of  A  =  1.  In  general,  a  spheroid  (ellipsoid 
with  a=b=c )  has  a  depolarization  of  A  =  1/N,  where  N  is  the 
number  of  spatial  dimensions.  Other  oblate  and  prolate  cases  can 
also  be  evaluated  directly  with  the  depolarization  integral. 
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APPENDIX  B.  Program  Codes 


10 
20 
U> 
40 
SO 
60 
70 
80 
90 
100 
1 10 
120 
130 
140 
ISO 
160 
170 
180 
190 
200 
2  10 
220 
2  30 
240 
2  SO 
260 

2  70 
280 
290 
300 
310 
320 

3  30 
340 

3  SO 
360 
370 
380 
190 
400 

4  1  0 
420 
4  30 
440 
4  SO 
4  60 
4  70 


*_*_*_*_*_*_*_*_*  —  *-  *-  *-  * 

"DIEL_BOND" 

Program  in  HP  BASIC  for  numeric  analysis  based  on  the  bond  model 


i  <<<<<<<  "DIEL^BONDS"  >>>>>>> 

!  A  main  program  to  evaluate  a  3  dimensional  composite  complex 
!  dielectric  reoponse  for  a  pixel  network  of  capacitors. 

!  S.  R.  Wallin,  6/1/91 

I  *  —  —  *  —  *  —  *  —  —  *  —  *  —  ★  —  *  —  *  —  ★  —  *  —  *  —  * 

PRINT  "  MEMORY  IS" ; VAL ( SYSTEMS ( "AVAILABLE  MEMORY" ) ) /8 ; " ( reals ) " 

OPTION  BASE  1 


DATA  1,0,2,1,4,3,7,6,11,10,16,15,22,21,29,28,37,36  !  Prog  diel  data 
COM  /Pass/Relay (0: 7)  1  for  sharing  to  subs  1  var 

COM  /Pixel/Chdr$ [ 80 ] ,Dhdr$(80] , INTEGER  Lxtnt , Pixl ( 1 : 20 , 1 : 20 , 1 : 20 ) 

COMPLEX  Hpiv ( 1 : 202 ), Hpr ( 1 : 10000 )  !  dim  to  reasonable  size  for  3D 

DIM  Hdr$[80]  !  available  string  for  headers 

COMPLEX  Admt (0:7), Admsl , Adms2  1  neighbor  admittance  values 

INTEGER  Kube, Xt (0:7) ,Yt(0:7) ,  Zt ( 0 : 7 )  !  neighbor  addresses 

COM  /Men,r/Graf ( 1 : 512, 1:4) ,Ahdr$[80] , Bhdr$[80] , INTEGER  Rep,Kwd  Itrials  mem 
!***>  COM  areas  can  be  reaccessed  with  next  RUN  if  identical  name  &  sizes 


!***>  nb. ,  max  Lside  >=  .  5  +  cube  root (.2 5  +  2* (max  dim  -  1)  ) 

LET  Start =TIMEDATE 


INTEGER  Lside, Kond, Nodesz 

I nteger  Pt rn , Nd , Nd 1 , Nd2 , Boxes , Slant , Spr ss 

INTEGER  Xkin, Ykin, Zkin, Xcnt , Ycnt , Zcnt , Xaddr , Yaddr , Zaddr 

INTEGER  Qdrnt , Rptr, Trans, Pose,Grpt,Tls,Sctr, Itmp,Occp, Nsvf ,Rsw 

I NTEGER  Hmem , Hedge , Hpremax , Hopped , Hsteps , Hnde , Hcnt , Kent , Hkm 

INTEGER  Cnmb , Hnbr (0:7), Hcnr , Jxt 

DIM  Frpx (0:9) ,Msd$(60] ,Fln$[60] , Fsv$[60) 

COMPLEX  Ctmp, Resp, Hnrm, Diel ( 1 : 9 ) 

LET  Grpt=0  1  Initialize  the  data  storage  counter 

»  *  —  *  —  *  —  *  — .  *  —  *  —  *-.*_*  —  *  —  *  —  *  —  *  —  *  —  *  —  *  —  *  —  * 

!  for  which  the  integer  variables  roles  are: 

!  Relay  =  an  available  common  pass  variables 

!  Lside  =  the  §  of  pixel  capacitor  elements  encounter  along  an  edge 

!  of  the  square  of  pixels 

!  Tls  =  Lside  or  Lside/2  if  2x2x2  tiling 

!  Qdrnt  =  quadrant  pixel  array  expanding  switch,  0=off  &  l=on 

!  Pxtot  =  total  #  of  pixels  in  square  =  Lside*Lside 

!  Rsw  =  even/odd  switch,  etc 

!  Kond  =  the  boundary  condition  on  the  sides  of  the  o/erall  composite 
!  capacitor,  1)  insulating  sides  or  2)  periodic  or  sides  which 

!  wrap  around 

!  Nodesz  =  the  maximum  number  of  interaction  nodes  in  forming 
!  network,  with  0  as  the  ground  or  base  plate,  1  as  center 

!  node,  and  the  final  node  number  for  the  top  plate. 

!  Its  value  is:  L*L*L/4+L*L/4-5L/2+4 


X  SECTION  OF  CAPACITOR  CUBE 
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480 
490 
500 
510 
520 
530 
540 
550 
560 
570 
580 
590 
600 
610 
620 
6  1 
640 
650 
660 
670 
680 
690 
700 
710 
720 
730 
740 
750 
760 
770 
780 
790 
800 
810 
820 
830 
840 
850 
860 
870 
880 
890 
900 
910 
920 
930 
940 
950 
960 
970 
980 


1 

1 

! 

1 

! 

1 

! 

i 

1 

i 

1 

i 

! 

! 


xxxxxxxxxx 

xxxxxxxxxx 

xxxxxxxxxx 

xxxxxxxxxx 

xxxxxxxxxx 

xxxxxxxxxx 

xxxxxxxxxx 

xxxxxxxxxx 

xxxxxxxxxx 


top  node  or  plate 


center  node  at  midpoint 


base  node  or  plate 


X's  represent  nodes 


!  Pixl()  =  the  overlaying  matrix  representing  the  capacitor  pixels 
!  Dsplc()  =  displacement  current  of  pixel  per  normalized  volt/meter 

!  Potnt ( )  =  pixel  voltage  relative  to  one  volt  across  entire  sample 

!  Diel()  =  dielectric  value  or  admittance  value  of  a  capacitor  pixel 
!  attached  to  addresses  represented  in  the  pixel  grid 

!  Frpx ( )  =  volume  fractions  associated  with  pixel  types 
!  Xt(),Yt()  =  neighbor  addresses 

!  Fln$  =  string  refering  to  a  filename,  Hdr$  =  80  chars 

!  Ahdr$,Bhdr$  =  headers  of  80  chrs  for  Data  Title  &  ID  for  COM  /Memr/ 

1  Chdr$,Dhdr$  =  headers  of  80  chrs  for  Pixel  Title  &  ID  for  COM  /Pixel/ 

!  Ptrn  =  choice  of  pixel  grid  filling  pattern 

!  Nd  =  a  single  number  label  for  a  node 

!  Ndl,Nd2  =  refers  to  a  1st  node  &  a  2nd  node  @  specified  by  single 

!  node  numbers 

!  Xkin, Ykin, Zkin  =  kinship  3D  address  of  a  node  number  ie  (x,y,z) 

!  Xcnt , Ycnt , Zcnt  =  step  counters  to  pixels  neighbouring  a  node  in  3D 

!  Xaddr , Yaddr , Zaddr  =  addresses  of  neighbouring  pixels  in  3D 

!  Boxes  =  total  concentric  boxes  fitting  within  pixel  grid  or 

!  number  of  2x2  cell  blocks  along  an  edge  on  pixel  grid 

!  Jxt  =  a  juxtaposition  counter 

!  Kube  =  inside  cube  territory  test 

!  Slant  =  0  if  toward  slash  or  1  if  backslash  slanting  capacitor 

!  Rep,Rptr  =  overall  number  of  repeats,  Kwd=#  of  data  storage  types 

!  Grpt  =  overall  plus  transpose  repeats  for  use  of  data  storage 
!  Sprss  =  Suppression  of  printout  details 
!  Trans, Pose  =  Pixel  transpose  selection 

!  Resp  =  Overall  dielectric  response  of  pixel  sample  along  E 

!  Nsvf  =  switch  indicating  if  intended  to  save  repeat  info 

!  Tmp, Tmpl , Tmp2 , Vt 1 , Vt2  =  reals  available  for  various  uses 

I  *  —  *  —  *  —  *_*  —  *  —  *  —  *  —  *  —  *_*_*  —  A 

PRINT 

PRINT  "  >  >  >  Happy  capacitor  composite  adventures  in  3  dimensions  <  <  <" 
PRINT  "  preformed  on  DATES (TIMEDATE ) ; 

PRINT  ”  at  " ;TIME$ (TIMEDATE) 

PRINT 


990  !################## 

1000  !  The  hopper  reduction  subarray:  S.  Wallin,  July  1990 

1010  !  .  .  >  large  symmetric  sparse  matrix  . 

1020  !  |  1,1 |  <=<  NODE  PAIR 
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1030  ! 

1040  ! 

10S0  1 

1060  ! 

1070  ! 

1080  !  . .  The  hopper  subarray  moves 

1090  !  . .  down  as  pivoting  progresses 

11C0  !  \/  lg  sym  sparse  matrix 

1110  !  . 

1120  !  The  "H"  prefix  is  mainly  used  to  denote  variable  use  in  hopper  program 

1130  !  Hnbr(*)  =  neighbor  nodes 

1140  !  Hedge  =  altitude  or  base  or  diag  #  elements  of  reduction  hopper 

1150  !  Hmem  =  the  total  #  of  elements  contained  within  reduction  hopper 

1160  !  Hpremax  =  same  as  Hmem  but  less  Hedge  ( ie  less  largest  row) 

1170  !  Hsteps  =  extent  of  larger  interaction  matrix  upon  hopper  reduces 

1180  !  Hcnr  =  corner  node  # s  of  insulated  sides  Pixel  grid  cube 

1190  !  Hpiv()  =  Pivoting  vector  of  node  reduction 

1200  !  Hpr()  =  working  hopper  array  of  matrix  reduction 

1210  !######*########### 

1220  PRINT  ">Try  hopping  along  to  a  solution  of  sparse  matrices  at 

1230  DISP  "IO  to  be:  0)default  l)lab  3.5’"’  2)lab  hardisc  3,4)A,B  office 

1240  INPUT  " 5 ) user  defined", Nd 

1250  IF  Nd<0  THEN  STOP 

1260  IF  Nd=0  THEN  Msd$=”" 

1270  IF  Nd=l  THEN  Msd$=" : CS80 , 700 , 1 " 

1280  IF  Nd=2  THEN  Msd$=" : CS80 , 700" 

1290  IF  Nd=3  THEN  Msd$=” : CS80, 703 , 0” 

1300  IF  Nd=4  THEN  Msd$=" : CS80, 703 , 1 " 

1310  IF  Nd=5  THEN  INPUT  "Name  (completely)  storage? ",MsdS 
1320  IF  Msd$<>" "  THEN  PRINT  RPT$ ( "  ",  50) ; "storage" ;Msd$ 

1330  PRINT  "  The  pattern  choices  are:" 

1340  PRINT  "  0)  internal,  via  COM  /Memr/" 

1350  PRINT  "  1)  from  file  storage" 

1360  PRINT  "  2)  every  pixel  filled  by  user” 

1370  PRINT  "  3)  random  (i.e.  well  mixed)" 

1380  PRINT  "  4)  by  slanted  fill  level" 

1390  PRINT  "  5)  with  an  circle  or  ellipse  of  which  can  be  tilted" 

1400  PRINT  "  6)  with  strata" 

1410  PRINT  "  7)  concentric  boxes" 

1420  PRINT  "  8)  an  ellipse  with  host  &  inclusion  (2  components  only,"; 

1430  PRINT  "  but  symm  wrt  1/2  vol ) " 

1440  INPUT  "Select  design  of  pixel  grid?  (see  above)", Ptrn 
1450  IF  Ptrn<0  THEN  STOP 

1460  !DISP  "  &  boundary  conditions?  1)  Insulative  " ; 

1470  i INPUT  ”2)  Wrap  around  or  periodic" , Kond 

1480  LET  Kond= 1  ! TEMPORARY 

1490  IF  Kond<0  THEN  STOP 

1530  IF  Kond=0  THEN  Kond=l 

1510  IF  Kond>2  THEN  Kond=l+BIT(Kond+l , 0 ) 

1520  [INPUT  "Use  2x2x2  tiles  on  pixel  grid?  0)  No  1)  Yes",Tls 
1530  Tls=0  [temporary  until  programmed 
1540  IF  Tls<0  THEN  STOP 
1550  LET  Tls=l+(Tls=l) 

1560  [INPUT  "Oct-  fold  symmetry  expansion  of  pixel  grid?  0)  No  1)  Yes",Qdrnt 
1570  LET  Qdrnt=0  [temporary  until  programmed 


_#1_  _  <=<hopper  address 

2,1  2,2 

_#2 _ #3 _ 

3,1  3,2  3,3 

_#  4 _ #5 _ i#6_ 
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1580  IF  Qdrntco  THEN  STOP 
1590  LET  Qdrnt=l+ (Qdrnt=l ) 

1600  SELECT  Ptrn 

1610  CASE  =0 

1620  IF  Lxtnt<2  THEN 

1630  PRINT  ”  Are  Pixels  there  in  memory?  ..idled  ..start  again" 

1640  STOP 

1650  END  IF 

1660  IF  Lxtnt>21  THEN  PRINT  “  ..  there  may  be  too  many  Pixels" 

1670  REDIM  Pixl ( 1 : Lxtnt , 1 : Lxtnt , 1 : Lxtnt ) 

1680  LET  Lside=Lxtnt*Qdrnt*Tls 

1690  PRINT  ”  From  internal  memory  via  COM,  Pixels" ; Lxtnt ; "x" ; Lxtnt ; "x” ; Lxtnt ; ' 

title, " 

1700  IF  Chdr$<>" "  THEN  PRINT  Chdr$ 

1710  IF  Dhdr $<>” ”  THEN  PRINT  Dhdr$ 

1720  CASE  =1  !  Get  pixels  from  file 

1730  INPUT  "  Enclose  (in  '"'""a)  file  name  to  contain  pixel  pattern? ", Fln$ 

1740  IF  Fln$=" ”  THEN  STOP 

1750  IF  POS ( Fln$ , " : " ) =0  THEN  Fln$=Fln$&Msd$ 

1760  DISP  "  File  named  ;Fln$;"""  ( [ " ;LEN ( Fln$ ) ; " ]  characters)"; 

1770  DISP  "  is  being  read  from  storage" 

1780  ASSIGN  @Pixsrc  TO  Fln$; FORMAT  OFF 

1790  ENTER  @Pixsrc ; Chdr$ , Dhdr$ ; Lxtnt  1  NB  header  assigned  length  of  80 

1800  PRINT  "  Pixels  contained  in  file  """;Fln$; . ,  entitled  with" 

1810  PRINT  Chdr$ 

1820  PRINT  Dhdr $ 

1830  REDIM  Pixl ( 1 : Lxtnt , 1 : Lxtnt , 1 : Lxtnt )  1  read  initial  Pixl(*)  array 

1840  ENTER  @Pixsrc ; Pixl ( * )  !  retreive  pixels  from  file 

1850  ASSIGN  @Pixsrc  TO  *  !  close  file 

1860  LET  Lside=Lxtnt*Qdrnt*Tls  I  actual  Pixel  side  anticipated 

1870  PRINT 

1880  CASE  ELSE  !  Generate  pixels 

1890  DISP  "How  big  a  capacitor  pixel  grid  in  elements/side? 

1900  INPUT  "(even  #,  max  "20  int  addr  lmt)",Lside 
1910  IF  Lside<0  THEN  STOP 

1920  IF  LsideoSHIFT  ( SHIFT  ( Lside ,  1 )  ,  -1 )  THEN 

1830  PRINT  "  Odd" ;Lside; "Pixel  length  changed  to  even"; 

1940  LET  Lside=SHIFT ( SHIFT (Lside, 1) , — 1 ) 

1950  PRINT  Lside 

1960  END  IF 

1970  IF  Lside=0  THEN  Lside=2 

1980  LET  Lxtnt=Lside  !  initial  Pixel  side  length 

1990  LET  Lside=Lside*Qdrnt*Tls  1  Pixel  side  length  anticipated 

2000  IF  Lside>32  THEN  PRINT  "  ...  near  integer  addressing  limit" 


2010  END  SELECT  !  end  Ptrn  test 

2020  PRINT 

2030  IF  Tls=2  OR  Qdrnt=2  THEN  PRINT  "  Pixels  now 

measures" ; Ls ide ; "x" ;Ls ide ; "x" ; Lside 
2040  PRINT  "  Pattern=” ; Ptrn; ")" ;Lside; "x" ;Lside; "x" ; Lside 
2050  IF  Tls=l  THEN  PRINT  "pixels,"; 

2060  IF  Tls=2  THEN  PRINT  "tiled  pixels,"; 

2070  IF  Kond=l  THEN  PRINT  "  insulated  or  "”D""  field  parallel  to  edge." 
2080  IF  Kond=2  THEN  PRINT  ”  periodic  or  voltage  wrapping  around  at  edges." 
2090  ! ALLOCATE  REAL  Dsplc ( Ls ide , Ls ide , Ls ide ), Potnt ( Lside , Ls ide , Ls ide ) 

2100  !***>  Initializing 
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2110  MAT  D i e 1 = ( CMPLX (0,0) ) 

2120  DISP  "Dielectric  sources? 

2130  DISP  ”1)  (from  program)  2)  user 

2140  INPUT  ”3)  by  steps  4)  lossy/real  binary  ",Nd 

2150  IF  Nd=0  THEN  Nd=2 

2160  SELECT  Nd 

2170  CASE  =1 

2180  FOR  Ndl=l  TO  9 

2190  READ  Diel(Ndl) 

2200  NEXT  Nd 1 

2210  CASE  =2 

2220  FOR  Ndl=l  TO  9 

2230  DISP  "Give  dielectric  complex  value  at”;Ndl; 

2240  INPUT  "?  (or  enter  (-real,0)  if  to  cease )", Diel ( Ndl ) 

2250  IF  REAL (Diel (Ndl ) )<0  THEN 

2260  LET  Diel ( Ndl ) =CMPLX (0,0) 

2270  LET  Ndl=9 

2280  ELSE 

2290  PRINT  " d i e 1 ( ”;Ndl; " )=(" ; VAL$ ( DROUND ( REAL (Diel ( Ndl ) ), 4 ));"," ; 

2300  PRINT  VAL$ ( DROUND ( I MAG ( Diel ( Ndl )), 4 ));”),“ ; 

2310  END  IF 

2320  NEXT  Ndl 

2330  CASE  =3 

2340  INPUT  "Complex  dielectric  value  of  pixel  type  ""( 1 ]""?", Ctmp 

2350  DISP  "Multiplier  of  progression  for  each  succeeding  value 

2360  INPUT  "to  fill  (2), (3), ..,(9)  ?",Tmpl 

2370  FOR  Nd 1=1  TO  9 

2380  Diel (Ndl ) =Ctmp 

2390  Ctmp=Ctmp*Tmpl 

2400  PRINT  "diel [ ";Ndl; ")=("; VAL$ ( DROUND ( REAL ( Diel ( Ndl ) ) , 4 ));"," ; 

2410  PRINT  VAL$ ( DROUND ( I MAG ( Diel ( Nd 1 )), 4 ));")," ; 

2420  NEXT  Ndl 

2430  CASE  =4 

2440  DISP  "Constituent  [1]  is  solely  imaginary ( lossy ) ,  ie=(0,_),"; 

2450  INPUT  "  what  is  the  value?  ",Tmpl 

2460  LET  Diel ( 1 ) =CMPLX ( 0, Tmpl ) 

2  4  70  DISP  "Constituent  (2)  is  solely  real,  ie=(_,0),"; 

2480  INPUT  "  what  is  the  value?  ",Tmpl 

2490  LET  D lei ( 2 ) =CMPLX ( Tmpl , 0 ) 

2500  CASE  ELSE 

2  MO  STOP 

2520  END  SELECT 

2  5.30  PRINT 

2540  LET  Spi 3S= 1 

2550  IF  Nodes z<32  THEN 

2560  INPUT  "Surpress  screen  listing  details,  0)  No  1)  Yes?",Sprss 
2670  IF  Sprss<0  THEN  STOP 

2580  END  IF 

2590  INPUT  "Any  overall  repeats  (0=single  manual  run)?  ”,Rep 
2600  LET  Rep=SHIFT ( Rep, -1 )  !!  double  if  conjugates 

2610  LET  Relay (0)=Rep  I  Manual  when  Relay=0 

2620  LET  Relay ( 1 ) =SHIFT ( Rep, 1 ) +1  1  repeat  conjugates 

2630  IF  Rep<0  THEN  STOP 

2640  IF  Rep=0  THEN  LET  Rep=l  !  If  manual,  still  go  thru  once 

2650  LET  Nsvf =0 


55 


2660  IF  Rep>l  THEN 

2670  INPUT  "Save  data  in  a  file?  0=No  l=Yes  ",Nsvf 
2680  LET  Nsvf=BIT(Nsvf,0) 

2690  IF  Nsvf =0  THEN 

2700  LET  Fsv$=" " 

2710  ELSE 

2720  INPUT  "Name  a  new  file  to  receive  data  output  ”,Fev$ 

2730  IF  Fsv$<>” "  THEN  LINPUT  "Title  or  description?  (<80)  ",Ahdr$ 

2740  END  IF 

2750  END  IF 

2760  INPUT  "Desire  transpose  of  pixel  grid?  0)  No  1)  Yes", Pose 
2770  IF  Pose<0  THEN  STOP 
2780  LET  Pose=l+BIT(?ose,0) 

2790  REM  "  Solution  acheived  by  a  sparse  matrix  reduced  pivoting  technique" 
2800  !***»  Overall  repetition,  may  require  additional  editing 

2810  LET  Stmrp=TIMEDATE  1  Timer  for  repeat" 

2820  LET  Kwd=4  1  user  has  selected  to  program  for  4  data  columns 

2830  REDIM  Graf (l:Rep, l:Kwd) 

2840  MAT  Graf=(0)  !  Intialize  to  zero 

2850  FOR  Rptr= 1  TO  Rep 

2860  LET  Rsw=BIT(Rptr, 0)  ! Even=0/Odd=l  switch 

2870  !ILET  Grpt=Grpt+l  !  Increment  data  store  counter 

2880  LET  Grpt=Grpt+Rsw  !  .'Increment  storage  counterfon  2s) 

2890  IF  Relay(0)<>0  THEN  LET  Relay ( 0 ) =Rptr  IStandard  option  of  Relay 

2900  MAT  Frpx=(0)  'Reset  volume  fractions  to  0 

2910  MAT  Diel=CONJG (Diel )  J Iconjugation  option 

2920  ! ! IF  Rptr>0  AND  Rptr  MOD  Lside*Lside=0  THEN  MAT  Diel=CONJG ( Diel )!! Con jg 

2930  i**>  if  ptrn=0  internal  or  Ptrn=2  then  Pixels  read  from  file 

2940  IF  Ptrn=2  THEN  CALL  Pixl3d_fill 

2950  IF  Ptrn=3  THEN  CALL  Pixl3d_rand 

2960  IF  Ptrn=4  THEN  CALL  Pixl3d_tilt 

2970  IF  Ptrn=5  THEN  CALL  Pixl3d_ellps 

2980  IF  Ptrn=6  THEN  CALL  Pixl3d_strat 

2990  IF  Ptrn=7  THEN  CALL  Pixl3d_cbox 

3000  IF  Ptrn=8  THEN  CALL  Pixl2d_3d 

3010  IF  Tls=2  THEN 

3020  LET  Xkin=SI ZE ( Pixl , 1 )  !  redimensioning 

3030  LET  Ykin=SIZE(Pixl,2) 

3040  LET  Zkin=SIZE(Pixl, 3) 

3050  LET  Ndl=2 * ( Xkin+Ykin+Zkin )  DIV  3  !  ave  new  dimension 

3060  LET  Nd2=SHIFT(Xkin*Ykin*Zkin,-3)  1  8*Xkin*Ykin*Zkin 

3070  REDIM  Pixl ( 1 : 1 , 1 : Nd2 )  •  shifting  Pixl  array  contents 

3080  FOR  Xcnt= ( Xkin-1 )  TO  0  STEP  -1 

3090  FOR  Ycnt=Ykin  TO  1  STEP  -1 

3100  LET  Pixl ( 1 , 1 , Xcnt *2  * i kin+Ycnt ; =Pix 1 ( 1 , 1 , Xcnt *Ykin+Ycnt ) 

3110  NEXT  Ycnt 

3120  NEXT  Xcnt 

3130  REDIM  Pix 1 ( 1 : Nd 1 , 1 : Nd 1 , 1 : Nd 1 )  !  set  new  array  dimen 

3140  FOR  Xcnt=Xkin  TO  1  STEP  -1  !  tiling  2x2 

3150  FOR  Ycnt=Ykin  TO  1  STEP  -1 

3160  1  LET  Itmp-Pixl( 1, Xcnt, Ycnt) 

3170  LET  Xaddr=SHIFT ( Xcnt , -1 )  !  effective  2*  op 

3180  LET  Y add r  =  SHI  FT (Ycnt, -1 ) 

3190  LET  Pix 1 ( 1 , Xaddr , Yaddr ) =Itmp 

3200  LET  Pix 1 ( 1 , Xaddr- 1 , Yaddr ) =Itmp 
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3210  LET  Pixl ( 1 , Xaddr, Yaddr-1 ) =Xtmp 

3220  LET  Pixl ( 1, Xaddr- 1 , Yaddr-1 ) =Itmp 

3230  NEXT  Vent 

3240  NEXT  Xent 

3250  END  IF 

3260  IF  Qdrnt=2  THEN 

3270  LET  Ndl= (SIZE(Pixl, l)+SIZE(Pixl,2)+SIZE(Pixl,3) )  DIV  3 

3280  LET  Nd2=SHIFT(Nd2,-l) 

3290  REDIM  Pixl  ( 1 :  Nd2 , 1 :  Nd2 , 1 :  Nd2  )  1  redim  to  dble  quad  duplic 

3300  FOR  Xcnt=Ndl  TO  1  STEP  -1 

3310  LET  Xaddr=Nd2+l-Xcnt  !  quad  complement  X  counter 

3320  LET  Xkin=SHI FT ( Xcnt+1 , 1)  1  effectively  DIV  2  op 

3330  LET  Ykin=BIT( Xcnt+1 , 0)  1  effectively  odd<=>even  op 

3340  FOR  Ycnt=l  TO  Ndl 

3350  LET  Yaddr=Nd2+l-Ycnt  1  quad  complement  Y  counter 

3360  LET  Itmp=Pixl(l,Xkin,Ycnt+Ndl*Ykin) 

3370  LET  Pixl ( 1 , Xcnt , Ycnt ) =Itmp  1  Itmp  takes  care  of  redim  elements 

3380  LET  Pixl(l, Xaddr, Ycnt)=Itmp 

3390  LET  Pixl(l,Xcnt, Yaddr ) =Itmp 

3400  LET  Pixl ( 1 , Xaddr, Yaddr ) =Itmp 

3410  NEXT  Ycnt 

3420  NEXT  Xcnt 

3430  END  IF 

3440  LET  Lside=SIZE(Pixl, 1)  1  update  Pixl  extent  along  edge 

3450  LET  Px_tot=Lside*Lside*Lside  !  update  actual  Pixl  volume 

3460  LET  Boxes=SHI FT ( Lside , 1 )  !  1/2  of  edge  length  in  Pixls 

3470  IF  Boxesd  THEN  PRINT  "WARNING!  may  be  too  small  of  a  pixel  grid” 

3480  LET  Nodes2=SHIFT(Lside*Lside* (Lside+1) , 2) -SHIFT ( 5*Lside, 1 ) +4 

3490  !***>  Tranpose  of  Pixel  grid 

3500  LET  Trans=Pose  !  if  loop  then  use  next  line 

3510  ! FOR  Trans=l  TO  Pose 

3520  IF  Trans=2  THEN  !  Tranpose  in  @  Xplanes 

3530  PRINT  "  TRANSPOSING  about  the  X  direction” 

3540  FOR  Xcnt= 1  TO  Lside 

3550  FOR  Ycnt=l  TO  Lside 

3560  FOR  Zcnt= ( Ycnt+ 1 )  TO  Lside 

3570  LET  Itmp=Pixl (Xcnt , Zcnt, Ycnt )  ! swap  Ycoordinate<->Zcoordinate 

3580  LET  Pixl ( Xcnt , Zcnt , Ycnt ) =Pixl (Xcnt , Ycnt , Zcnt ) 

3590  LET  Pixl (Xcnt, Ycnt, Zcnt)=ltmp 

3600  NEXT  Zcnt 

3010  NEXT  Ycnt 

3620  NEXT  Xcnt 

3630  END  IF 

3640  !***>  Evaluation  of  pixel  type  volume  fractions 

3650  IF  NOT  (Sprss)  OR  LsideclO  THEN  PRINT  ”  Pixe  Is Ls  ide;  'x”  ;  Lside ;  "x Lside 

3660  FOR  Xcnt=l  TO  Lside  Iby  X-plane  sections 

3670  IF  NOT  (Sprss)  OR  LsideclO  THEN  PRINT  RPT$ ( ”  ",  Boxes ); ”X=" ;VAL$ (Xcnt ) 

3680  FOR  Zcnt=Lside  TO  1  STEP  -1  !Z  printout  by  rows,  largest  Z  1st  row 

3690  FOR  Ycnt=l  TO  Lside  !Y  printout  across,  increasing  Y 

3700  LET  Frpx ( Pixl ( Xcnt , Ycnt, Zcnt ) ) =Frpx ( Pixl ( Xcnt , Ycnt, Zcnt ) )+l 

3710  IF  NOT  (Sprss)  OR  LsideclO  THEN  PRINT  ”  ” ;VAL$ ( Pixl ( Xcnt , Ycnt , Zcnt )) ; 

3720  NEXT  Ycnt 

3730  IF  NOT  (Sprss)  OR  LsideclO  THEN  PRINT 

1/49  NEXT  Zcnt 

3760  NEXT  Xcnt 
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MAT  Frpx=Frpx/ ( Px_tot ) 

PRINT  "  Volume  %s: 

FOR  Nd=l  TO  9 

IF  Frpx{Nd)<>0  THEN  PRINT  PROUND { 100*Frpx ( Nd ),- 1 );"%=>("; Nd ;"),  " ; 

NEXT  Nd 
PRINT 

IF  Frpx (0)<>0  THEN  PRINT  "WARNING  1  check  pixels" 

DISP  "  ..  wait" ; Rptr ; "of " ; Rep; " . .  solving  node  interact  matrix,"; 

DISP  Nodesz; "by" ;Nodesz; "from  time  " ;TIME$ (TIMEDATE) 

LET  Tmp=TIMEDATE  1  Benchmarker 

!***>  HOP  technique  of  sparse  matrix  reduction 

PRINT  "  Solving  node  INTERACTION  matrix" ;Nodesz; ”x" ;Nodesz; "via  hopper" 

LET  Hedge=SHIFT ( Lside*Lside , 1 ) +Lside-2  (hopper  edge,  max  interact  diff 

LET  Hmem= ( 1 . 0+Hedge ) *Hedge/2  !  total  hopper  memory  requirement 

LET  Hsteps=Nodesz 

LET  Hpremax=Hmem-Hedge 

REDIM  Hpiv ( 1 : Hedge ), Hpr ( 1 : Hmem) 

MAT  Hpiv= (CMPLX (0 , 0 ) ) 

MAT  Hpr = ( CMPLX (0,0) ) 

LET  Hkm=0  !  0,1, 3, 6..  previous  hopper  row  end 

FOR  Hnde=l  TO  Hedge  1  Filling  hopper  work  array 

IF  NOT  (Sprss)  THEN  PRINT  "  node  * s " ; Hnde ; "  lower  neighbors  are"; 

FOR  Sctr=0  TO  7  1  Diagonal  or  self  interact  terms 

IF  Kond=l  THEN  CALL  Cv3ndi ( Hnde , Lside, Sctr , Xt ( Sctr ), Yt ( Set r ), Zt ( Sctr ) ) 
IF  Kond=2  THEN  CALL  Cv3ndp ( Hnde , Lside , Sctr , Xt ( Sctr ), Yt ( Sctr ), Zt ( Set r ) ) 
LET  Kube= ( Xt ( Sctr )<1  OR  Xt ( Sctr ) >Lside  OR  Yt(Sctr)d)  ! in  cube? 

LET  Kube=  NOT  (Kube  OR  Yt ( Sctr ) >Lside  OR  Zt(Sctr)<l  OR  Zt ( Sctr ) >Lside ) 
IF  Kube  THEN 

LET  Admt ( Sctr ) =Diel ( Pixl ( Xt ( Sctr) ,Yt(Sctr) ,Zt(Sctr) ) ) 

IF  Kond=l  THEN  1  adj  for  insl  BC  on  Pixel  grid 

LET  Hcnr= ( Xt ( Sctr ) =1  OR  Xt (Sctr ) =Lside) !Pix  on  corner 
LET  Hcnr= (Hcnr  AND  (Yt(Sctr)=l  OR  Yt(Sctr)=Lside) ) 

LET  Hcnr= (Hcnr  AND  Zt(Sctr)>l  AND  Zt(Sctr )<Lside) 

IF  Hcnr  THEN  !  test  if  corner 

LET  Jxt=SHIFT ( SHIFT (Zt(Sctr) , 1) ,-l ) +BIT ( BINCMP ( Zt ( Set r ) ) ,0) 

LET  Admsl=Diel (Pixl(Xt(Sctr) ,Yt(Sctr) ,Zt(Sctr) ) ) 

LET  Adms2=Diel (Pixl(Xt(Sctr) ,Yt(Sctr) , Jxt) ) 

LET  Admsl=Admsl*Adms2 / ( Admsl+Adms2 ) 

LET  Admt (Sctr ) =Admsl  1  admittance  of  path 
END  IF  1  end  of  Hnde=Hcnr  test 

END  IF  !  end  if  for  Kond=l  test 

LET  Hpr ( Hkm+Hnde ) =Hpr (Hkm+Hnde ) '(Sctr)  Iself  interact 
IF  BIT ( Sctr , 0) =0  THEN  !  find  out  lower  Z  neighbors 

IF  NOT  (Sprss)  THEN 

PRINT  "  (" ;VAL$ (Xt (Sctr) );", ";VAL$(Yt (Sctr) );", "; 

PRINT  VAL$  (  Zt  (  Sctr )  )  ;")(§"; 

END  IF 
SELECT  Kond 
CASE  =1 

LET  Hnbr ( Sctr ) =FNNni (Xt(Sctr) ,Yt(Sctr) , Zt(Sctr) , Lside, 1 ) 

CASE  =2 

LET  Hnbr (Sctr ) =FNNnp(Xt (Sctr ) , Yt (Sctr ) , Zt (Sctr ) , Lside, 1 ) 

CASE  ELSE 

PRINT  "  out  of  bounds,  boundary  condition,  detected  in  HOPper" 
END  SELECT 
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IF  NOT  ( Sprss )  THEN  PRINT  VALS ( Hnbr ( Sctr ) )  ; 

IF  Hnbr (Sctr) >Hnde  THEN  PRINT  "  ???" ; 

IF  Hnbr (Sctr) <=Hnde-Hedge  THEN  PRINT  "Node” ; Hnbr ( Sctr ); "outside  of 
hopper  at";Hnde 

IF  Hnbr (Sctr) <Hnde  AND  Hnbr ( Sctr )>0  THEN 

LET  Hpr (Hkm+Hnbr (Sctr) )»Hpr (Hkm+Hnbr (Sctr ) )-Admt(Sctr) Ineighbr 


END  IF 
END  IF 
END  IF 
NEXT  Sctr 

IF  NOT  (Sprss)  THEN  PRINT 
LET  Hkm=Hkm+Hnde 
NEXT  Hnde 
LET  Kcnt=0 
IF  NOT  (Sprss)  THEN 
FOR  Xcnt= 1  TO  Hedge 
FOR  Ycnt=l  TO  Xcnt 


i  end  if  for  even  Sctr 
t  end  if  for  Kube 

!  end  of  output  line 
i  loop  count  accumulator 
!  end  of  set  up  of  work  matrix 


1  printout  HOPper 


PRINT  " ( "; VAL$ ( DROUND ( REAL (Hpr (Kcnt+Ycnt) ) ,3) ) ; " , "; 

PRINT  VAL$ ( DROUND ( I MAG ( Hpr ( Kcnt+Ycnt ) ) , 3 ) ) ; " )  "; 

NEXT  Ycnt 
PRINT 

LET  Kcnt=Kcnt+Xcnt 
NEXT  Xcnt 
END  IF 

FOR  Hopped=l  TO  Hsteps-1 
LET  Hnde=Hedge+Hopped 
LET  Hpiv ( 1 ) =CMPLX (1,0) 

LET  Kcnt=2 

IF  Hpr ( 1 ) =CMPLX (0,0)  THEN 
PRINT  " lst=0? " ; 

MAT  Hpiv= ( CMPLX (0,0)) 

ELSE 

LET  Hnrm=l/Hpr ( 1 ) 

FOR  Hcnt=2  TO  Hedge 

LET  Hpiv ( Hcnt ) =Hpr ( Kent ) *Hnrm 

LET  Kcnt=Kcnt+H~nt  1  2 , 4 , 7 , 11 , . . @lst  elmnt  in  hoppr  row 

NEXT  Hcnt 
END  IF 


!  Let  the  PIVOTING  begin,  &  drip  dry 
!  count  of  oncoming  node  number 
!  normalize  to  1st  elment  pivot  vectr 
i  convert  array  storage  for  1st  colmn 
S  don’t  waste  steps  if  O 


i  set  normalizing  multiplier 
J  set  pivot  vector 


!***>  one  can  output  pivot  here  for  backsub  later 
IF  NOT  (Sprss)  THEN 

IF  Hnde<=Hsteps+l  THEN 

PRINT  "feed  node" ;Hnde-l ; 

FOR  Ycnt=l  TO  Hedge  1  printout  of  hopper  feed  row 

PRINT  " ( "; VAL$( DROUND (REAL (Hpr (Hpremax+Ycnt) ), 3 ));"," ; 
PRINT  VAL$ (DROUND ( IMAG(Hpr( Hpremax+Ycnt )), 3) );" ) 

NEXT  Ycnt 
PRINT 

END  IF  1  end  if  for  Hnde<Hsteps 

PRINT  ”  At  reduct  ion” ;Hopped ; "the  complex  pivots  are:" 

LET  Xcnt=MIN( Hedge, Hsteps-Hopped+1 )  Jsignificant 
FOR  Hcnt=Xcnt  TO  1  STEP  -1 

PRINT  "{" ;VAL$( DROUND (REAL (Hpiv (Hcnt) ) ,4) ) ;", "; 

PRINT  VAL$ ( DROUND ( IMAG( Hpiv (Hcnt ) ) ,4) ) ;"}"; 

NEXT  Hcnt 

IF  Hpi v ( 1 ) =CMPLX (0,0)  THEN  PRINT  "?!"; 
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PRINT 
END  IF 

LET  Kcnt=l  !  initialize  filling  counter 

FOR  Xcnt=2  TO  Hedge  1  heart  of  pivoting 

IF  Hpiv ( Xcnt ) OCMPLX (0,0)  THEN  1  eparseness  efficiency  =0,  no-op 
FOR  Ycnt=2  TO  Xcnt  1  adj  each  array  row  with  pivot  vectr 

IF  Hpiv (Ycnt) OCMPLX (0,0)  THEN  1  sparseness  efficiency  =0,  no-op 
LET  Hpr (Kent + Ycnt ) =Hpr (Kent +Ycnt ) -Hpr ( Kcnt+1 ) *Hpiv (Ycnt ) 

END  IF 
NEXT  Ycnt 
END  IF 

LET  Kcnt=Kcnt+Xcnt  11,3,6,10,..  gives  previous  row  end 

NEXT  Xcnt 

LET  Kcnt=0  1  initialize  filling  counter  lower 

FOR  Xcnt=l  TO  Hedge-1  1  X,Y  refer  to  hopping  counters 

FOR  Ycnt=l  TO  Xcnt  1  hopping  along  for  shake  up 

LET  Hpr  ( Kcnt+Ycnt )  =Hpr  ( Kent + Ycnt -t-l+Xcnt ) 

NEXT  Ycnt 

LET  Kcnt=Kcnt+Xcnt 
NEXT  Xcnt 

FOR  Ycnt=l  TO  Hedge  !  feed  hopper,  clear  last  row 

LET  Hpr ( Hpremax+Ycnt ) =CMPLX (0,0) 

NEXT  Ycnt 

IF  NOT  (Sprss)  AND  Hnde<Hsteps  THEN  PRINT  "  node ' s" ; Hnde ; "  lower  neighbors 
are" ; 

FOR  Sctr=0  TO  7  1  find  neighbors 

SELECT  Hnde 

CASE  <Hsteps  1  feed  unless  over  lg  array  extent 

IF  Kond=l  THEN  CALL  Cv3ndi (Hnde, Lside, Sctr , Xt ( Sctr ) , Yt ( Sctr ) , Zt (Sctr ) ) 
IF  Kond=2  THEN  CALL  Cv3ndp (Hnde, Lside, Sctr , Xt ( Sctr ), Yt ( Sctr ), Zt ( Sctr ) ) 
LET  Kube= ( Xt ( Sctr ) < 1  OR  Xt (Sctr ) >Lside  OR  Yt(Sctr)<l)  ! in  cube? 

LET  Kube=(Kube  OR  Yt(Sctr)>Lside  OR  Zt(Sctr)<l  OR  Zt ( Sctr ) >Lside) 

LET  Kube=  NOT  (Kube) 

IF  Kube  THEN 

LET  Admt ( Sctr ) =Diel ( Pixl (Xt ( Sctr ) ,Yt(Sctr) ,Zt(Sctr) ) ) 

IF  Kond=l  THEN  1  adj  for  insl  BC  on  Pixel  grid 

LET  Hcnr=(Xt(Sctr)=l  OR  Xt ( Sctr ) =Lside) 1 Pix  on  corner 
LET  Hcnr= (Hcnr  AND  (Yt(Sctr)=l  OR  Yt ( Sctr ) =Lside) ) 

LET  Hcnr= ( Hcnr  AND  Zt(Sctr)>l  AND  Zt (Sctr)<Lside) 

IF  Hcnr  THEN  !  test  if  corner 

LET  Jxt=SHIFT ( SHIFT( Zt ( Sctr ) , 1 ) , -1 ) +BIT ( BINCMP ( Zt ( Sctr ) ) ,0) 

LET  Admsl=Diel ( Pixl ( Xt ( Sctr) ,Yt(Sctr) ,Zt(Sctr) ) ) 

LET  Adms2=Diel (Pixl (Xt (Sctr) ,Yt(Sctr) , Jxt) ) 

LET  Adm8l=AdmBl*Adms2/ ( Admsl+Adms2 ) 

LET  Admt (Sctr ) =Admsl 1  admittance  of  path 
END  IF  1  end  of  Hnde=Hcnr  test 

END  IF  1  end  if  for  Kond=l  test 

LET  Hpr ( Hmem) =Hpr ( Hmem) +Admt ( Sctr ) 

IF  BIT ( Sctr , 0 ) =0  THEN  1  find  lower  Z  neighor  interactions 
IF  NOT  (Sprss)  THEN  PRINT  " 

(  "  ;VAL$(Xt  (Sctr  )  )  ;  "  ,  "  ;  VALS  ( Yt  (  Sctr  )  )  ;  "  ,  ”  ;  VAL$  (  Zt  (  Set  r  )  );")(?" 
SELECT  Kond 
CASE  =1 

LET  Hnbr (Sctr )=FNNni (Xt (Sctr ) , Yt (Sctr ) , Zt (Sctr ) , Lside, 1 ) 

CASE  =2 
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LET  Hnbr  ( Sctr )  =FNNnp  ( Xt  ( Sctr )  ,  5ft  (Sctr )  ,  Zt  (Sctr )  ,  Lsi.de,  1 ) 

END  SELECT  I  to  SELECT  Kond 

IF  NOT  (Sprss)  THEN  PRINT  VAL$ (Hnbr ( Sctr )) ; 

IF  Hnbr ( Sctr ) >=Hnde  THEN  PRINT  ”  ???"; 

IF  Hnbr (Sctr) <=Hnde-Hedge  THEN  PRINT  "Node" ;Hnbr ( Sctr ); "outside  of 
hopper  at”;Hnde 

IF  Hnbr (Sctr)<Hnde  AND  Hnbr(Sctr)>0  THEN 
LET  Hnbr ( Sctr ) =Hnbr ( Sctr ) +Hmem-Hnde 
LET  Hpr ( Hnbr ( Sctr ) ) =Hpr ( Hnbr ( Sctr ) ) -Admt ( Sctr ) 

END  IF 

END  IF  1  end  if  for  even  Sctr 

END  IF  1  end  if  in  Kube 

CASE  =Hsteps  1  special  case,  exciter  electrode 

IF  BIT(Sctr, 0) =0  THEN  1  do  on  even  Sctr 

1  IF  NOT  (Sprss)  THEN  PRINT  ”  " ; VAL$ ( Hsteps ) ; 

FOR  Xcnt=l  TO  Boxes  1  pixels  which  abut  exciter  electrode 

LET  Xkin=SHIFT (Xcnt,-l)+BIT(Sctr,2)-l!  X  address  in  Sctr 
FOR  Ycnt=l  TO  Boxes  1  &  neighbors 

LET  5fkin=SHIFT  ( 5fcnt ,  -1 )  +BIT(  Sctr ,  1 )  -1 1  Y  addrss  in  Sctr 
LET  Hpr (Hmem) =Hpr (Hmem) +Diel (Pixl (Xkin, Ykin,Lside) ) 

LET  Hnbr ( Sctr ) =Hsteps-l- ( Boxes-Ycnt+1 ) *Boxes+Xcnt 
I  IF  NOT  (Sprss)  THEN  PRINT  ;VAL$ ( Hnbr ( Sctr ));! neighbr 
LET  Hnbr ( Sctr )=Hnbr( Sctr )+Hmem-Hnde  Irel.  to  hopper  address 
Hpr (Hnbr ( Sctr ) ) =Hpr ( Hnbr ( Sctr ) ) -Diel ( Pixl ( Xkin, Ykin, Lside) ) 

NEXT  Ycnt 
NEXT  Xcnt 

END  IF  !  end  if  even  SCTR 

END  SELECT  !  to  SELECT  Hnde 

NEXT  Sctr 

IF  NOT  (Sprss)  AND  Hnde<=Hsteps  THEN  PRINT  1  end  of  print  out  line 
NEXT  Hopped 
IF  NOT  (Sprss)  THEN 

PRINT  "  Complex  hopper  funnels  down  to  {” ;DROUND( REAL (Hpr ( 1 ) ) , 4) ; 

PRINT  ", ” ;DROUND(IMAG(Hpr(l) ) ,4) 

END  IF 

!***>  Hpr(l)  contains  the  end  of  the  interaction  reduction 
!  LET  Hpiv(Hsteps) =1/Hpr ( 1 )  !  backsubstitute  for  solution  vector 

!  FOR  Hcnt= (Hsteps-1 )  TO  1  STEP  -1 
!  LET  Hpiv ( Hcnt ) =0 

!  FOR  Kcnt=Hcnt  TO  Hsteps 

!  LET  Hpiv ( Hcnt ) =Hpiv (Hcnt ) -Pivotstorg (Hcnt , 1+Kcnt-Hcnt ) *Hpiv (Kent ) 

!  NEXT  Kent 

!  NEXT  Hcnt 

PRINT  "  ...  at  ”;TIME$(TIMEDATE) ; "  inversion  excution 

PRINT  "time  took" ; PROUND (TIMEDATE-Tmp, -1 ); "seconds" 

DISP 

LET  Resp=Hpr ( 1 ) /Lside  !  principal  diel  resp 

!***>  pixl  displacement  field/current  &  potentials 
!  FOR  Ycnt=l  TO  Lside 
!  FOR  Xcnt=l  TO  Lside 
!  Slant= (Xcnt+Ycnt)  MOD  2 

!  Xaddr=Xcnt-Boxes-Slant  !  (x,y)  of  node  upper  to  pixel 

!  Yaddr=Ycnt-Boxes 

!  CALL  Xy_to_node(Ndl,Xaddr, Yaddr, Lside, Kond) 

!  Xaddr=Xcnt-Boxes+Slant-l  !  (x,y)  of  node  lower  to  pixel 
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1  Yaddr=Ycnt-Boxes-l 

I  CALL  Xy_to_node(Nd2, Xaddr, Yaddr, Lside, Kond) 

1  IF  Ndl<>Nd2  AND  Ndl>0  AND  Nd2>0  THEN 

1  Dsplc (Xcnt , Ycnt ) =Diel ( Pixl ( 1 , Xcnt , Ycnt ) ) * (Hpiv ( Ndl ) -Hpiv ( Nd2 ) > 

'  Potnt (Xcnt , Ycnt ) = ( Hpiv (Ndl ) +Hpiv (Nd2 ) )/2 

1  END  IF 

1  IF  Nd2=0  AND  Ndl>0  THEN 

I  Dsplc ( Xcnt , Ycnt ) =Diel ( Pixl ( 1 , Xcnt , Ycnt ) ) *Hpiv (Ndl ) 

1  Potnt (Xcnt , Ycnt ) =Hpiv (Ndl ) /2 

i  END  IF 

1  NEXT  Xcnt 

1  NEXT  Ycnt 

!***>  additional  modification  of  Potential  &  Displacement  array  fields 
i  IF  Kond=l  THEN 

!  FOR  Ycnt=2  TO  (Lside-2)  STEP  2 

!  FOR  Nd=-1  TO  1  STEP  2 

!  LET  Xcnt= (Nd+1 ) *Boxes+ (Nd=-1 )  !  (Xcnt, Ycnt)  refer  to  pixel 

1  LET  Xaddr=Nd* ( Boxes-1 )  l  ( Xaddr , Yaddr )  refer  to  node 

!  LET  Yaddr=Ycnt-Boxes 

I  CALL  Xy_to_node ( Ndl , Xaddr , Yaddr+1 , Lside , Kond ) !  node  #  upper 

!  CALL  Xy_to_node ( Nd2 , Xaddr , Yaddr-1 , Lside, Kond ) !  node  #  lower 

!  IF  Ndl<>Nd2  AND  Ndl>0  AND  Nd2>0  THEN  1  Evaluate  along  side  nodes 

!  LET  Tmpl=Diel (Pixl ( 1 , Xcnt , Ycnt+1 )) !  Upper  dielectric  pixel 

1  LET  Tmp2=Diel ( Pixl ( 1 , Xcnt , Ycnt )) !  Lower  dielectric  pixel 

!  LET  Vt l=Hpiv ( Ndl ) 

!  LET  Vt2=Hpiv(Nd2) 

!  IF  TmploO  AND  Tmp2<>0  THEN  Tmp=  ( Vtl *Tmpl+Vt2 *Tmp2  )  /  (Tmpl+Tmp2  ) 

i  LET  Potnt (Xcnt , Ycnt+1 )= (Vtl+Tmp) /2 !  Pixl  volts 

!  LET  Potnt (Xcnt , Ycnt ) = ( Vt2+Tmp) /2 

1  IF  TmploO  AND  Tmp2<>0  THEN 

1  LET  Dsplc ( Xcnt , Ycnt+1 ) = ( Vtl-Vt2 ) / ( 1/Tmpl+l /Tmp2 ) 

!  END  IF 

!  LET  Dsplc ( Xcnt , Ycnt ) =Dsplc (Xcnt , Ycnt+1 ) !  Displacement  mag. 

!  END  IF 

!  NEXT  Nd 

!  NEXT  Ycnt 

!  END  IF 

!  MAT  Potnt=  Potnt* (Resp)  !  Normalizing  to  1  volt  across  sample 

!  MAT  Dsplc=  Dsplc* (Resp)  1  &  sum  of  displacements  along  row=diel 

!  LET  Ndl=l  !  sign  provider  for  following  loop 

!  FOR  Xcnt=l  TO  Lside 

!  LET  r.  esp2=Resp2+Ndl  *(  Dsplc  ( Xcnt ,  Boxes )  -Dsplc  (  Xcnt ,  Boxes+ 1 )  ) 

!  LET  Ndl=-Ndl 

!  NEXT  Xcnt 

!  LET  Resp2=Resp2/2  !  dielectric  response  perp  to  E 

!***>  Should  be  end  of  calculations,  printouts  follow 
!***>  Printout  of  the  dielectric  pixel  array 
IF  NOT  ( Sprss )  AND  LsideclO  THEN 

PRINT  "DIELECTRIC  PIXEL  ARRAY,  3-dimens ional Ls ide ;  'x Ls ide ; ”x Ls ide 
FOR  Xcnt=l  TO  Lside 

PRINT  RPT$("  " , Lside ) ; "X  plane=" ; VAL$ ( Xcnt ) 

FOR  Zcnt=Lside  TO  1  STEP  -1 
FOR  Ycnt=l  TO  Lside 

PRINT  " ( " ;VAL$ (DROUND( REAL (Die 1 (Pixl (Xcnt ,  Ycnt,  Zcnt ))),  3 ));","  ; 
PRINT  VAL$ ( DROUND ( I MAG (Diel(Pixl (Xcnt , Ycnt, Zcnt ) ) ) , 3 ) > ; ” ) 
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6470  NEXT  Ycnt 

6480  PRINT 

6490  NEXT  Zcnt 

6500  NEXT  Xcnt 

6510  END  IF 

6520  !***>  printout  of  the  hopper  array 

6530  !**»*>  Find  the  ser ies<->paral lei  factor 

6540  LET  Ctmp=FNWnr (Diel ( * ) , Frpx ( * ) , Reap, Tmp, 9 ) 

6550  PRINT 

6560  PRINT  "Compoaite  Dielectric  Response  Tensor  Components:" 

6570  PRINT  "  principal=" ; Reap 

6580  PRINT  "  &  series<->parallel  factor  ="; 

6590  PRINT  " ( ” ;  VAL$ (DROUND (REAL (Ctmp) ,4) ) ; " , " ; VAL $ (DROUND ( IMAG ( Ctmp) , 4 ) ) ; " ) 
6600  PRINT  "(+/-  " ;VAL$ (DROUND ( 100 *Tmp, 4) ) ;"%  iteration  error)" 

6610  PRINT 

6620  !  IF  Spras=0  THEN 

6630  !  PRINT  "PIXEL  VOLTAGES  2-dimensional Lside ; "by "; Lside 

6640  !  Tmp=FNMatprnt ( Potnt ( * )  , -Lside ) 

6650  !  PRINT  "PIXEL  DISPLACEMENT  FIELD  MAGNITIUDES Ls ide ; "by Lside 

6660  1  Tmp=FNMatprnt (Dsplc (*), -Lside ) 

6670  !  END  IF 

6680  !***>  NOTE:  Tranpose  used  then  it  is  an  additional  cycle  to  Rptr 

6690  !Graf (Grpt , 1 ) =Rptr+Tmp/100 
6700  ! Graf (Grot , 2 ) =Frpx ( 1 ) 

6710  ! Graf (Grpt , 3 ) =REAL ( Ctmp)  !  save  real  part  of  exp  ave  factor 

6720  !Graf (Grpt , 4 ) = IMAG (Ctmp)  !  save  imag  part  of  exp  ave  factor 

6730  Graf (Grpt, 1 )=( Rptr+Tmp/100 )*. 25+Graf (Grpt , 1 )+. 125 
6740  Graf (Grpt , 2 ) =Frpx ( 1 ) * . 5+Graf (Grpt , 2 ) 

6750  Graf (Grpt , 3 ) =REAL ( Ctmp) * . 5+Graf (Grpt , 3 ) 

6  7  CO  Graf (Grpt , 4)=IMAG( Ctmp) * . 5+C raf (Grpt , 4 ) 

6770  'NEXT  Trans 
6780  NEXT  Rptr 

6 7 u  !***>  output  repeat  calculations 

6800  uE\'  S tmrp=TIMEDATE-Stmrp  !  Repeat  tir,.e  elapsed 

6810  IF  Stmrp>300  THEN  BEEP  !  Beep  if  longer  than  5  minutes 

6823  IF  Rptr>l  THEN  PRINT  " Finished" ; Rptr-1 repeat  trials  in" ;Stmrp; ” seconds 

6830  LET  Bhdr$=" ( "&VAL$ ( La ide )& "x"&VAL$ ( Lside ) & "x "&VAL$ ( Lside )& " ) " 

6840  IF  T1 s= 1  THEN  LET  Bhdr$=BhdrS&"  elmnts” 

6850  IF  T1 s=2  THEN  LET  Bhdr $=Bhdr$& "/( 2x2x2 s ) " 

6860  IF  Kond= 1  THEN  LET  Bhdr$=Bhdr $& "  InslBC" 

6870  IF  Kond=2  THEN  LET  Bhdr$=Bhdr $&"  PrdcBC" 

6880  LET  Bhdr $=Bhdr $&"  Sparse"  1  solution  by  sparse  methods 
6890  IF  Qdrnt=2  THEN  LET  Bhdr$=Bhdr$&"  4fold" 

6900  IF  Pt rn=0  THEN  Bhdr$=Bhdr $& "  intrnl," 

6910  IF  Ptrn=l  THEN  Bhdr $=8hdr $& "  "&Fln$ 

6920  IF  Ptrn=2  THEN  Bhdr$=Bhdr$&"  USER," 

6930  IF  Ptrn=3  THEN  Bhdr$=Bhdr$&"  RANDOM," 

6940  IF  Ptrn=4  THEN  Bhdr$=Bhdr$&"  SLANT," 

6950  IF  Ptrn=5  THEN  Bhdr$=Bhdr$&"  ELLIPSE," 

6960  IF  Ptrn=6  THEN  Bhdr $=Bhdr$&"  STRAT," 

6970  IF  Ptrn=7  THEN  Bhdr $=Bhdr$&"  BOXES," 

6980  LET  Occp=LEN ( Bhdr$ ) 

6990  LET  Bhdr$ [ 1+Occp] =RPTS ( "  ” ,80-Occp)  !  pad  with  blanks 

7000  LET  Bhdr $ ( 60 ] = ”  " &DATE$ ( TIME DATE )&", "&TIME$ ( TIME DATE ) 

7010  LET  Dhdr$=Bhdr$ 


63 


7020  IF  Rep=l  THFN  PRINT  “  for  the  case  abbreviated 
7030  IF  Rep=l  THEN  PRINT  Bhdr$ 

7040  IF  Rep>l  THEN 

7050  PRINT  ”  Summary  of " ;Grpt; "repeat  variations:  (as  programmed)" 

7060  FOR  Rptr=l  TO  Grpt 

7070  PRINT  "  Case"; ( (Rptr-1)  DIV  Pose) +1 ;")", DROUND (Graf (Rptr , 1 ), 4 ) , 

7080  PRINT  DROUND (Graf (Rptr, 2  ) ,  4 )  , DROUND (Graf (Rptr, 3 ) , 4) , 

7090  PRINT  DROUND (Graf ( Rptr , 4 ) , 4 ) 

7100  NEXT  Rptr 

7110  IF  Nsvf =0  THEN 

7120  DISP  "  Save  repeat  info  (array  form, SIZE (Graf , 1 ); "x” /SIZE (Graf , 2 ) ; 

7130  INPUT  ")?  0)  No  1)  Def initely " , Ndl 

7140  ELSE 

7150  LET  Ndl=0 

7160  IF  Fsv$<>" "  THEN 

7170  REDIM  Graf (l:Grpt, l:Kwd) 

7180  CREATE  Fsv$,l  !< — <DOS  if  1  unit 

7190  ASSIGN  QSavstr  TO  Fsv$; FORMAT  OFF 

7200  OUTPUT  @Savstr ; Ahdr $ , Bhdr $ , Grpt , Kwd ,Graf(*),END 

7210  ASSIGN  @Savstr  TO  * 

7220  ELSE 

7230  Ndl=l 

7240  END  IF 

7250  END  IF 

7260  IF  Ndl=l  THEN 

7270  DISP  ”  Enclose  (in  """"s)  new  file  name  to  send  info  vectors  to?"; 

7280  INPUT  "  ( @/nul l=use  old  file)",Fln$ 

7290  IF  POS ( Fln$ , ” : " ) =0  THEN  Fln$=FIn$&Msd$ 

7300  LINPUT  "  Title,  (up  to  80  characters) " ,Ahdr$ 

7310  LET  Ahdr$ ( 1+LEN ( Ahdr$ ) ] =RPT$ ( "  " , 80-LEN(Ahdr$ ) ) !  pad  with  blanks 

7320  DISP  ”  File  named  . ;Fln$; .  ( ( ” ;LEN ( Fln$ ) ; ” )  characters)”; 

7330  DISP  ”  to  contain  repeat  info” 

7340  PRINT  ”  File  . ;Fln$; . s  user  and  description  headers  are  ”; 

7350  PRINT  "(2  lines):” 

7360  PRINT  Ahdr$ 

7370  PRINT  Bhdr$ 

738C  IF  Fln$=" ”  OR  Nsvf=l  THEN 

7390  INPUT  "  Enter  the  filename  to  be  created?  null=stop" , Fln$ 

7400  IF  Fln$=" "  THEN  STOP 

7410  !DISP  "  Enter  f ile"'”';Fln$; . 's  storage  size  limit  in  bytes  ('”; 

7420  DISP  VAL$ ( 256+8*Rep*Pose*Kwd );")"; 

7430  INPUT  " ? " , Ndl 

7440  ! !  IF  Ndl< 1048  THEN  Ndl=1048  !  1  kiloBYTE  min  (LIF  disks) 

7450  CREATE  Fln$,Ndl 

7460  ELSE 

7470  IF  POS (Fln$,":")=0  THEN  Fln$=Fln$&Msd$ 

7480  END  IF 

7490  ASSIGN  @Infostr  TO  Fln$ ; FORMAT  OFF 

7500  OUTPUT  @Infostr;Ahdr$, Bhdr $, Rep , Kwd , Graf (*), END 

7510  ASSIGN  @Infostr  TO  * 

7520  END  IF 
7530  END  IF 

7540  !***>  Pixel  file  output  choice 

7550  LET  Nd 1=0 

7560  !  I F  Ptrnol  THEN  INPUT  "  Save  last  pixel  grid?  0)No  l)Yes",Ndl 
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7  570  LET  Ndl=0  1 1  temporary  unitl  reprogramming  done 
7580  IF  Ndl=l  THEN 


7590  DISP  "  Enclose  (in  n"""s)  new  file  name  to  send  pixel  pattern  to?"; 
7600  INPUT  "  (null=use  old  file)",Fln$ 

7610  IF  POS ( Fln$ , " : " ) =0  THEN  Fln$=Fln$&Msd$ 

7620  LINPUT  ”  Title  (up  to  80  characters)  if  null  then  default  label", Chdr$ 
7630  LET  Dhdr$=Bhdr$ 

7640  DISP  "  File  named  . ;Fln$;"""  ( [ " ;LEN(Fln$) ; " ]  characters)"; 

7650  DISP  ”  contains  the  pixel  grid" 

7660  PRINT  '■  File  . ;Fln$;" . s  header  is  " 

7670  PRINT  Hdr$ 

7680  IF  Fln$<>" "  THEN 

7690  DISP  "  Give  f ile" " " ; Fln$ ; " " " 1 s  max  capacity  limit  in  bytes"; 

7700  DISP  "?  (~";VAL$(128+SHIFT(Px_tot,-l) ) ;”)"; 

7710  INPUT  "  " , Ndl 

7720  IF  Ndl<256  THEN  Ndl=256 

7730  CREATE  Fln$,Ndl 

7740  ELSE 

7750  INPUT  "  Enter  the  existing  filename? ", Fln$ 

7760  IF  POS ; Fln$ , ” : " ) =0  THEN  Fln$=Fln$&Msd$ 

7770  END  IF 

7780  ASSIGN  @Pixstr  TO  Fln$ ; FORMAT  OFF 

7790  OUTPUT  @Pixstr; Hdr $ , Lside ,Pixl(*), END 

7800  ASSIGN  @Pixstr  TO  * 


7810  END  IF 

7820  !***>  interaction  file  output  choice 

7830  PRINT  RPT$ ( "  ”,  2 5 );"... elapsed" ; PROUND (TIMEDATE-Start , -1 ) ; 

7840  PRINT  "sec  for  completion  at  " ;TIME$ (TIMEDATE ) 

7850  PRINT  ”  MEMORY  IS" ; VAL ( SYSTEM$ ( "AVAILABLE  MEMORY” )) /8 ;”( reals ) ” 

7860  LET  Lxtnt=Lside  1  update  COM  /Pixel/  ie  Pixl(*)  size 

7870  END 

7880  !  )(  )(  ][  ](  ][  ](  ](  ]{  ](  ](  )[  )[  )[  )[  ][  )(  ](  ][  ][  )[  )[  )[  )[  )[ 

7890  SUB  Cv3ndi ( INTEGER  Nodi , Lszi , Sctr i , Xouti , Yout i , Zout i ) 

7900  !  Converts  a  node  number  of  layering  scheme  into  the  (x,y,z) 

7910  !  coordinates  of  neighboring  nodes 

7920  !  IN  Nodi  =  node  number 

7930  !  IN  Lszi  =  Pixl  extent  along  either  X  or  Y 

7940  !  IN  Sctri  =  selection  adjacent  Pixl  neighbor  to  node 

7950  !  ie,  quadrant  number  from  binary  (x/0/1  y/0/1  z/0/1) 

7960  !  example  5>=>101  or  x=l  y=0  z=l  or 

/'•/()  !  (0=  X  lower, Y  lower  Z  lower;  1=  X  lower, Y  lower,  Z  higher 

7980  !  2=  X  lower,  Y  higher,  Z  lower;  etc 

7990  !  OUT  Xouti  =  X  coordinate  address  outcome 

8000  !  OUT  Youti  =  Y  coordinate  address  outcome 

8010  !  OUT  Zouti  =  Z  coordinate  address  outcome 

8020  !  internal  variables: 

8030  !  Lyri  =  a  counter  for  number  of  layers 

8040  !  Swi  =  an  even  odd  switch 

8050  !  Ovri  =  overfill  counter 

8060  !  Nodmaxi  =  maximum  node  for  given  Pixel  grid  size,  Lszi 

8070  !  Hfszi  =  half  of  Pixel  grid  size,  Lszi  (then  Lszi  must  be  even) 

8080  !  Sqvi  =  1/4  of  square  whose  edges  are:  Lszi*Lszi 

8090  !  Bilv  =  the  number  of  nodes  between  bilayers  z={l,2  3,4  5,6  .. 

8100  INTEGER  Lyr i , Swi , Ovri , Nodmax i , Hf szi , Sqvi , Bi lv 

8110  LET  Sctr i=BINAND ( Sctr i , 7 )  !  mask  only  relevant  bits 
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8120 

8130 

8140 

8150 
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8170 

8180 

8190 

8200 

8210 
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8240 
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8260 

8270 
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8310 
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8330 
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8360 
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8380 
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8450 
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8600 

8610 

8620 
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IF  BIT(Lszi,0)  THEN  PRINT  "  warning,  odd  Pixel  grid  extent" 

LET  Sqvi=SHIFT(Lszi*Lszi,2)  !  1/4  of  crtuare  Lszi*Lszi 

LET  Bilv=SHIFT(Lszi*Lszi, 1 ) +Lszi-3  INodes  n  bilayer 
LET  Nodmaxi=Sqvi* ( Lszi+1 ) -SHIFT( 5*Lszi, 1 ) +4  Imax  node  # 

LET  Hfszi=SHIFT(Lszi, 1 )  i  effectively  DIV  2  operation 

SELECT  Nodi 

CASE  <1  !  grounded 

LET  Xouti=Hfszi 
LET  Youti=Hf szi 
LET  Zouti=0 

CASE  >=Nodmaxi  i  exciter  node 

LET  Zouti=Lszi+l 
LET  Youti=Hfszi 
LET  Xouti=Hfszi 

CASE  ELSE  i  node  is  in  cube 

LET  Lyri= (Nodi-1 )  DIV  Bilv  1  for  Bilayer 

LET  Ovri=(Nodi-l)  MOD  Bilv  !  for  #  Nodes  in  Bilayer  itself 

LET  Swi=(Ovri>=Sqvi)  1  0=lower  l=upper  in  Bilayer 

IF  Swi  THEN  LET  Ovr i=Ovri-Sqvi  !  adjust  for  #  Nodes  in  upper 

LET  Zout i=l+SHIFT (Lyri , -l)+Swi+BIT(Sctri,0) 

IF  Swi=0  THEN  !  compute  according  to  z  level 

LET  Yout i=l+SHIFT (Ovri  DIV  Hf szi, -1 ) +BIT ( Sctri , 1 ) 

LET  Xouti=l+SHIFT(Ovri  MOD  Hf szi, -1 ) +BIT( Sctri , 2 ) 

ELSE 

IF  Ovri< (Hf szi-1 )  THEN  !  along  Y=1  edge 

LET  Youti=BIT(Sctri, 1) 

LET  Xouti=SHIFT (Ovr i , -1 ) +2+BIT{ Sctri , 2 ) 

ELSE  !  not  along  Y=1  edge 

LET  Ovri=Ovri-Hfszi+l 
LET  Youti=Ovri  DIV  (Hfszi+1) 

LET  Xouti=Ovri  MOD  (Hfszi+1) 

IF  Youti=Hf szi-1  THEN  1  along  Y=Lszi  edge 

LET  Xouti=SHIFT(Xouti, -1 ) +2+BIT ( Sctr i , 2 ) 

ELSE  !  somewhere  in  cube 

LET  Xout i=SHIFT ( Xouti , -l)+BIT(Sctri,2) 

END  IF 

LET  Yout i=SHIFT ( Yout i,-l)+2+BIT( Sctri, 1) 

END  IF 
END  IF 
END  SELECT 
SUBEND 

•  H  )(  H  )(  )(  K  )[  H  ](  H  H  ][  H  H  H  H  ](  H  H  H  H  H  H  H 

DEF  FNNni ( INTEGER  Xn, Yn, Zn,Lszn,Lup) 

!  Returns  the  node  number  for  Pixel  grid  network  cube 
!  of  capacitors  for  case  of  insulated  sides. 

!  (Xn,Yn,Zn)  3D  coordinates  of  Pixel  leading  to  the  nearest  node 
!  If  Up=l  then  Pixl  situated  above  node,  else  Pixl  situated  below  node 
!  Where  up  is  orientation  towards  exciter  electrode 
!  &  down  is  orientation  towards  grounded  electrode 

INTEGER  Ysw, Ndb, Lyr , Lsqhv, Ztyp, Zz 

LET  Zz=Zn  I  Copy  of  Z  value  for  function  call 

LET  Lup=BIT(Lup,0) 

LET  Lyr=SHIFT( Lszn, 1 )  !  in  essence  divides  by  2 

LET  Lsqv=SH IFT(Lszn*Lszn,2)  !  l/4th  of  square  Lszn*Lszn 

IF  Xn>0  AND  Xn<=Lszn  AND  Yn>0  AND  Yn<=Lszn  AND  Zz>0  AND  Zz<=Lszn  THEN 
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LET  Ndb=l 

IF  Zz=l  AND  Lup  THEN  LET  Ndb=0  lat  ground  electrode  or  next  exciter 
IF  Zz=Lszn  AND  NOT  (Lup)  THEN  LET  Ndb=Lsqv* (Lszn+1 ) -SHIFT ( 5*Lszn, 1 ) +4 
REM  above  program  line  contains  computation  for  EXCITER  node  number 
IF  Ndb=l  THEN  1  Node  Numbering.  Executes  if  node  not  yet  assigned 
IF  Zz<0  THEN  Zz=-Zz  1  also  entry  line  if  node  recalc 

LET  Ztyp=BIT(Zz+l-Lup,0)  1  0=no  nodes  on  edge  l=on  edge 

LET  Ndb= ( Zz-l-Lup) *Lsqv+SHIFT ( Zz-Lup, 1 ) * ( Lszn-3 ) +Ztyp* ( 2-Lszn) 

LET  Ndb=Ndb+ (Lyr+Ztyp) *SHIFT( Yn+Ztyp-1, 1 )  Inode  #  up  to  y  row 
LET  Ndb=Ndb+SHIFT( Xn+l-Ztyp, 1 )  1  node  #  up  to  x  location 

IF  Ztyp=l  THEN  !  special  cases 

IF  Yn=l  THEN 
LET  Ndb=Ndb+l 

IF  Xn=l  OR  Xn=Lszn  THEN  Zz=- ( Zz+ ( l-SHIFT(Lup, -1 ) ) ) 

END  IF 

IF  Yn=Lszn  THEN 
LET  Ndb=Ndb-l 

IF  Xn=l  OR  Xn=Lszn  THEN  Zz=- ( Zz+ ( 1-SHIFT (Lup, -1 )) ) 

END  IF 

END  IF  ! for ( Ztyp=l ) 

END  IF  ! for ( if  Ndb=l ) 

IF  Zz<0  THEN  GOTO  8720  irecalculate 

ELSE 

LET  Ndb=- 1 
END  IF 
RETURN  Ndb 
FNEND 

•  )(  J(  H  )(  H  H  )(  )(  H  )(  It  Jt  H  H  )l  H  H  H  H  H  1  l  H  n  H 

SUB  Pixl3d_rand 

!***>  Subprogram  to  create  a  3D  pixel  array  of  random  distribution 
!  RANDOM  3D  PIXEL  GRID  &‘#l#%)(%*$* 

COM  /Pass/Relay ( 0 : 7 ) 

COM  / Pixel /Chdr$ ( 80] , Dhdr$ [ 80 ] , INTEGER  Lpix, Pixl (1:20,1:20,1:20) 

INTEGER  Xp, Yp, Zp, Xq, Yq,Zq,Fill, Frdm, Sqrs , Pxs, Pixtmp, When, Lt , Ldb 
INTEGER  Knpx , Nrdm, Rot , Dmn 

! LET  Xq=SIZE ( Pixl , 1 )<>Lpix  OR  S IZE ( Pix 1 , 2 ) oLside  OR  SIZE ( Pixl , 3 )<>Lpix 
REDIM  Pixl ( 1 : Lpix , 1 : Lpix , 1 : Lpix )  1?  needed  in  sub" 

PRINT  "  Enjoy  creating  a  randomized  3D  pixel  grid  whose  pixel  elements" 
PRINT  "  are  labelled  1..9" 

LET  Nrdm=INT ( Relay ( 0 )  +  . 0000001 )  1  Integer  of  relay 

IF  Nrdm=0  THEN  !  Manual  seed 

INPUT  "Random  seed?  (integer  or  neg  if  to  be  via  timer)", Nrdm 
INPUT  "Apply  to  0)  full  3D  pixel  cube  1)  to  2D  X-section  " , Dmn 
IF  Dmn>0  THEN 

INPUT  "Contortions?  none=0  compress=.5  elongate=2  ",Vchk 
IF  Vchk>. 25  AND  Vchk<.75  THEN  Vchk=l 
LET  Lt= INT ( Vchk+ . 5 ) 

ELSE 

LET  Lt=0 
END  IF 
ELSE 

LET  Lt=INT(Relay (2 ) )  MOD  3  i  Test  of  relay  fraction  0,1,2 

LET  Dmn=INT ( . 0000001+Relay ( 4 ) )  1  Relay(4)  pony  for  2D  or  3D 

IF  Dmn=0  THEN  Lt=0 
END  IF 
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9220 

LET  Ldb=l+(Lt>0) 

1  Doubling  factor 

9230 

IF  Nrdm=0  THEN  RANDOMIZE  INT(TIMEDATE  MOD  32767) 

9240 

IF  Nrdm>0  THEN  RANDOMIZE  Nrdm 

9250 

LET  Fill=0 

9260 

LET  Sqrs=Lpix*Lpix/Ldb 

9270 

LET  Knpx=Sqrs 

9280 

IF  Dmn=0  THEN  Knpx=Knpx*Lpix 

9290 

LET  When=0 

9300 

LET  Pxs— 0 

9310 

LET  Rq=0 

9320 

LET  Nrdm=SHIFT ( INT ( Relay ( 0 ) +1 . 000001 ) , 1 )  ! IDivide  by  2  conj  pairing 

9330 

IF  Relay ( 0 ) >=1  AND  Relay(l)<>0  THEN 

LET  Rq=100*FRACT(Nrdm/Relay ( 1 ) ) 

9340 

WHILE  FilKKnpx 

9350 

LET  Pxs=Pxs-l 

1  Decrement 

9360 

WHILE  Pxs<0 

9370 

LET  When=When+l 

9380 

IF  INT ( Relay ( 0 ) ) =0  THEN 

9390 

DISP  "Filling  with  component 

VAL$ (When) ;"} ,  give 

volume 

9400 

INPUT  "percent  (volume  fraction  *  100)  ",Rq 

9410 

ELSE 

9420 

IF  When>l  THEN  Rq=-1 

lFill  with  rest,  after 

1st  pass 

9430 

END  IF 

9440 

IF  Rq<0  THEN 

9450 

LET  Pxs=Knpx-Fill 

9460 

ELSE 

9470 

LET  Pxs=INT ( Rq*Knpx* . 01+ . 5 )  MOD  Knpx 

9480 

IF  Pxa>Knpx-Fill  AND  Knpx>Fill  THEN  Pxs=Knpx-Fi 1 1 

9490 

END  IF 

9500 

PRINT  "  Component  ( " ; VALS (When) 

;")  is  assigned" ; Pxs*Ldb; "pixels 

9510 

END  WHILE 

9520 

IF  Pxs>0  AND  Dmn>0  THEN 

9530 

LET  Fill=Fill+l 

lUpdate  current  square 

location 

9540 

LET  Zp=( (Fill-1)  DIV  Lpix ) +1 

IRow  of  location 

9550 

LET  Yp=Fill- ( Zp-1 ) *Lpix 

iColumn  of  location 

9560 

LET  Pixl ( 1 , Zp, Yp) =When 

iAssign  pixel 

9570 

END  IF 

9580 

IF  Pxs>0  AND  Dmn=0  THEN 

9590 

LET  Fill=Fill+l 

lUpdate  current  square 

location 

9600 

LET  Zp=( (Fill-1)  DIV  Sqrs)+1 

! Level  between  electrodes 

9610 

LET  Xq=( Fill-1)  MOD  Sqrs 

! remainder 

9620 

LET  Yp= ( Xq  DIV  Lpix)+1 

!Y  row  in  a  Z  level 

9630 

LET  Xp= ( Xq  MOD  Lpix)+1 

9640 

LET  Pixl ( Xp, Yp, Zp) =When 

!X  location  in  Y  row 

9650 

END  IF 

9660 

END  WHILE 

9670 

!***>  lotto-ing  or  random  mixing 

9680 

IF  Dmn=0  THEN 

9690 

FOR  Fill=l  TO  Knpx 

9700 

LET  Frdm=INT ( l+RND*Knpx ) 

9710 

IF  FilloFrdm  AND  Frdm<=Knpx  THEN 

9720 

LET  Zp= ( (Fill-1)  DIV  Sqrs)+1 

9730 

LET  Xp= (Fill-1)  MOD  Sqrs 

9740 

LET  Yp= ( Xp  DIV  Lpix ) +1 

9750 

LET  Xp= ( Xp  MOD  Lpix ) + 1 

9760 

LET  Zq= ( ( Frdm-1 )  DIV  Sqrs)+1 
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LET  Xq= ( Frdm-1 )  MOD  Sqrs 
LET  Yq= ( Xq  DIV  Lpix)+1 
LET  Xq= ( Xq  MOD  Lpix)+1 
LET  Pixtmp=Pixl(Xp, Yp, Zp) 

LET  Pixl  ( Xp, Yp, Zp)=Pixl(Xq,Yq, Zq) 

LET  Pixl (Xq, Yq, Zq) =Pixtmp 

! PRINT  ”r” ; VAL$ ( Frdm) ; "p" ; VAL$ ( Pixtmp) ;  lcheck  random  sequencing 
END  IF 
NEXT  Fill 
ELSE 

FOR  Fill=l  TO  Sqrs 

LET  Frdm=INT( l+RND*Sqrs) 

IF  FilloFrdm  AND  Frdm<=Sqrs  THEN 
LET  Xp= 1 

LET  Zp=l+( (Fill-1)  MOD  Lpix) 

LET  Yp=l+( (Fill-1)  DIV  Lpix) 

LET  Xq=l 

LET  Zq=l+( (Frdm-1)  MOD  Lpix) 

LET  Yq=l+( (Frdm-1)  DIV  Lpix) 

LET  Pixtmp=Pixl ( Xp, Yp, Zp) 

LET  Pixl(Xp, Yp,Zp)=Pixl(Xq, Yq,Zq) 

LET  Pixl (Xq, Yq, Zq) =Pixtmp 

! PRINT  "r " ;VAL$ ( Frdm) ; "p" ;VAL$ ( Pixtmp) ;  lcheck  random  sequencing 
END  IF 
NEXT  Fill 

FOR  Y p= 1  TO  Lpix  ! swap 

FOR  Zp= ( 1+Yp)  TO  Lpix 

LET  Pixtmp=Pixl ( 1 , Yp, Zp) 

LET  Pixl(l,Yp,Zp)=Pixl(l,Zp,Yp) 

LET  Pixl ( 1 , Zp, Yp) =Pixtmp 
NEXT  Zp 
NEXT  Yp 
IF  Ldb>l  THEN 

FOR  Yp=Lpix  TO  1  STEP  -1  iCcntort  expand 
LET  Yq=SHI FT ( Xp+1 , 1 ) 

FOR  Zp= 1  TO  Lpix 

LET  Pixl ( 1 , Yp, Zp) =Pixl ( 1 , Yq, Zp) 

NEXT  Zp 
NEXT  Yp 
END  IF 

FOR  Xp=2  TO  Lpix  ICopy  over  X  planes 

FOR  Yp= 1  TO  Lpix 
FOR  Zp=l  TO  Lpix 

LET  Pixl (Xp, /p,Zp)=Pixl(l,Yp,Zp) 

NEXT  Zp 
NEXT  Yp 
NEXT  Xp 

IF  Relay ( 0 ) =0  THEN  INPUT  "Rotate  about  Z  axis?  0=N/1=Y  " , Rot 
IF  Rot= 1  OR  Relay ( 3 ) =1  THEN 

FOR  Zp= 1  TO  Lpix  ! swap 

FOR  Yp= 1  TO  Lpix 

FOR  Xp= ( 1+Yp)  TO  Lpix 

LET  Pixtmp=Pixl (Xp, Yp, Zp) 

LET  Pixl (Xp, Yp, Zp) =Pixl( Yp,Xp,  Zp) 

LET  Pix 1 ( Yp, Xp, Zp) =Pixtmp 
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NEXT  Xp 
NEXT  Yp 
NEXT  Zp 
END  IF 

END  IF  1  Dmn=0  for  3D  or  Dmn>l  for  2D 

SUBEND 

i  H  ](  )[  H  )(  ][  H  )(  H  M  H  H  ][  ][  ][  H  ][  H  H  H  H  H  H  H 

DEF  FNWnr ( COMPLEX  Diel (  *  )  , REAL  Frpx (*), COMPLEX  Din, REAL  Alferr, INTEGER  Nth) 
REM  Object  of  this  function  subprogram  is  to 
REM  find  the  exponential  averaging  factor  (or 
REM  percolation  related  factor)  "alf” 

REM  from  a  given  set  of  complex  number 
REM  dielectric  values  &  fractional  volume 
REM  weights  and  effective  or  resultant 
REM  complex  dielectric  value  of  composite 
REM  written  by  S.  Wallin,  4/91. 

REM  The  Wiener  or  exponential  averaging  factor 
REM  is  defined  as  follows: 

REM  DielO ( resu ltant ) * A1 f  =  sum  (Frpx(k) *Diel (k) ‘Alf } 

REM  where  DielO ( resultant )  =  response  of  composite 

REM  Aif  =  exponential  ave  or  Wiener  or  percolation  factor 

REM  Frpx(k)  =  fractional  volumes  of  species  k 

REM  Diel(k)  =  (dielectric)  response  of  species  k 

COM  /Pass/Relay ( 0 : 7 ) 

INTEGER  I , J , K , K1 , K2 , Kdo , Ns , Lsn , Lst , New 

COMPLEX  DielO, DlogO, Alf , Al f 0 , CO , Cl , C2 , C3 , Clg , Clg2 

LET  Ns=Nth 

IF  Ns<=0  THEN  STOP 

ALLOCATE  COMPLEX  Dlog(Ns) 

LET  Avg=0 
LET  Diel0=Din 
FOR  1=1  TO  Ns 

IF  Diel ( I ) <>CMPLX (0,0)  THEN  Avg=Avg+Frpx ( I ) 

NEXT  I 

REM  Normalize  ACTIVE  volume  to  total  1 
FOR  1=1  TO  Ns 

!  IF  AvgoO  THEN  LET  Frpx  ( I )  =Frpx  { I ) /Avg 
IF  Diel ( I ) =CMPLX(0, 0)  THEN  Frpx(I)=0 
NEXT  I 

SPRINT  "  Species  data:  (trial#,  complex  ” ;CHR$ ( 238 ) ; "  pair,  adj  vol  wt ) ” 

! FOR  1=1  TO  Ns 

! PRINT  ”  [ # " ; I ; "  ]  ("; REAL ( Diel ( I ));",”; IMAG ( Diel ( I ));")", DROUND ( Frpx ( I ), 4 ) 

! NEXT  I 

! PRINT  "  (  eff]  ( ” ; REAL (DielO);","; IMAG (DielO); ”)”,1 
REM  Determination  of  slope  direction  by  log  wt 
LET  Dlog0=CMPLX (0,0) 

IF  DielOoCMPLX  (0,0)  THEN  D logO  =  LOG  ( D ie  10 ) 

LET  Clg=CMPLX (0,0) !  Clg=Logarthimic  mean 
LET  C lg2  =  CMPLX (0,0) 

FOR  1=1  TO  Ns 

LET  Dlog ( I ) =CMPLX (0,0) 

IF  Diel ( I )<>CMPLX(0,0)  THEN  Dlog ( I ) =LOG ( Diel ( I ) ) -DlogO 
LET  Clg=Clg+Frpx( I ) *Dlog( I ) 

LET  Clg2=Clg2+Frpx( I ) *Dlog ( I ) *Dlog ( I ) 

NEXT  I 
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LET  Lan=-SGN ( REAL (Clg ) ) 

!  PRINT  ”  The  logarithmic  slope  is  " ;DROUND (REAL (Clg ) , 4 )  ; 

'.PRINT  DROUND(IMAG(Clg)  ,4)  .-"indicates  "  ;  CHR$  ( 224  )  "  iB  "; 

!  I P  Lan  = 1  THEN  1  PRINT  "positive." 

1  I F  Lsn=0  THEN  1  PRINT  "at  zero." 

!  I F  Lsn=-1  THEN  1  PRINT  "negative." 

REM  Extrema  values 
LET  Lst=0 
LET  Zst  =  0 
FOR  1=1  TO  Ns 

IF  Frpx ( I ) <>0  THEN 

LET  Tmp=Lsn*ABS ( Diel ( I ) ) 

IF  Tmp>Zst  OR  Zst=0  THEN 
LET  Zst=Tmp 
LET  Lst=I 
END  IF 
END  IF 
NEXT  I 

IF  Lsn=0  THEN  Lst=0 
LET  A 1  £ =CMPLX (0,0) 

IF  Lst>0  AND  Lst<=Ns+l  THEN 

IF  Dlog ( Lst ) OCMPLX (0,0)  THEN  A1 f =-LOG ( Frpx ( Lst ) ) /Dlog ( Lst ) 
END  IF 

LET  C0=CMPLX ( Lsn , 0 ) 

IF  Clg2<>CMPLX (0,0)  THEN  C0=-2*Clg/Clg2 !A  2nd  guess 
LET  Wt  =ABS ( CO ) 

LET  Wt=l/ ( l+wt*wt ) IRelative  weights  for  ave  the  2  guesses 
LET  A1 f  =  A1 f  +Wt * ( C0-A1 f ) 1  Combined  lst  guess 
SPRINT  ”  Guess  1  " ;CHR$ (224) ; ”  =  "; 

SPRINT  DROUND ( REAL ( A1 f ) ,4) ; DROUND ( IMAG ( Alf ) ,4) 

LET  A1 £0=CMPLX (0,0) 

LET  Alferr=l 
LET  J  =  2 
LET  New=0 

WHILE  AlfoAlfO  AND  J<32  AND  Alferr>1.0E  13 
IF  New= 1  THEN 

LET  Alf0=Alf ! Keep  track  of  last  iteration 
New=0 
END  IF 

LET  C 1 =CMPLX (0,0) 

LET  C2  =CMPLX (0,0) 

LET  C3=CMPLX (0,0) 

LET  K=01Keep  count  of  non-zero  terms 
FOR  1=1  TO  Ns 

LET  C0=Alf *Dlog( I ) 

IF  ABS(REAL(C0) )>700  THEN  IFailure  possible 
LET  A1 f=-2*Clg/Clg2 
LET  A 1 f  0=CMPLX (0,0) 

LET  C0=CMPLX (0,0) 

LET  Cl =CMPLX (0,0) 

LET  Alferr=0SSet  to  exit 
END  IF 

IF  COoCMPLX  (0,0)  AND  Diel(I)<>0  THEN 
LET  C0=Frpx( I ) *EXP(C0) 

LET  C1=C1+C0 
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LET  C2=C2+Diog ( I ) *C0 
LET  C3=C3+Dlog ( I ) *Dlog { I ) *C0 
LET  K=K+l!Tally  another  non-zero  term 
END  IF 
NEXT  I 

IF  CloCMPLX (0,0)  AND  K>1  THEN  1  Log  func  deriv 
REM  0th,  1st,  &  2nd  logarithmic  derive 
LET  C2=C2/C1 
LET  C3=C3 /C1-C2  *C2 
LET  Cl=LOG { Cl ) 

REM  Newton-Raphson  estimate  via  2nd  degree  polynomial 
LET  K.1=SGN  ( REAL  (Cl )  ) 

LET  K2  =SGN ( REAL ( C2 ) ) 

LET  C0=CMPLX (0,0) 

SELECT  K2 
CASE  0 
! PRINT  "  o"; 

IF  C3oCMPLX (0,0)  THEN  LET  C0  =  -2*C1/C3 
IF  C0OCMPLX  (0,0)  THEN  LET  Alf =A1 f +K1 *SQR ( CO ) 

CASE  Lsn 
1  PRINT  "  +  "  ; 

LET  C0=C2  *C2-2  *C1 *C3 
IF  C0=CMPLX (0,0)  THEN 
LET  C0=2*C1/C2 
ELSE 

LET  C0  =  2 *C1 / ( C2  +K2 *SQR ( CO ) ) 

END  IF 

LET  Al f =A1 f-CO  'New  estm  of  exp  factor 
CASE  -Lsn 
! PRINT  " 

LET  C0=C2  *C2-2  *C1*C3 
IF  C0=CMPLX (0,0)  THEN 

IF  C30CMPLX (0,0)  THEN  LET  C0=C2/C3 
ELSE 

IF  C3<>CMPLX (0,0)  THEN  C0= (C2+K2 *SQR ( CO ) )/C3 
END  IF 

LET  Alf=Alf-C0  !New  estm  of  exp  factor 
END  SELECT 

LET  Alferr=ABS( REAL (Alf) -REAL ( Al f 0 ) ) +ABS ( IMAG < Al f ) -IMAG ( Al fO ) ) 

IF  ABS ( REAL ( Al f ) )>700  THEN  Al f=CMPLX (Lsn/2 , 0 ) -Clg/Clg2/ ( 1+J )! Retry 
LET  New=l  ISet  for  update 

END  IF 

! PRINT  ”  Guess" ; J; "  " ;CHR$ ( 224) ; "  =  ";Alf;”  varied' " ;A1 ferr 
LET  J=J+1 
END  WHILE 

LET  Alferr=ABS(Alf0-Alf )  [Iteration  variance 

!  IF  AlferroO  THEN  [PRINT  "  Iteration  variance  =";Alferr 
RETURN  Alf 
FNEND 

-A  —  *  —  *  —  *  —  *  —  *  —  *-.*  —  *  —  *  —  *  —  * 
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*  —  *  —  *  —  *  —  *_*  —  *  —  *  —  ★  —  *  —  *  —  *  —  * 

”DIEL_SITES" 

Program  in  HP  BASIC  for  numeric  analysis  based  on  the  site  model 


- 

*  —  * 

— 

*_*  —  *  —  *  — 

10 

REAL  Mem0,Tm0 

20 

LET  TmO 

-TIMEDATE 

30 

LET  Mem0=INT ( . 5+VAL ( SYSTEM$ ( "AVAILABLE  MEMORY" 

))) 

40 

!  < 

<  <  <  <  <  "DIEL  SITES" 

> 

>  >  >  >  > 

50 

!  *  — 

*  —  ★  —  *  —  *  —  *  —  *  - 

* 

_*  —  *  —  *  —  * 

60 

!  A  main  program  to  evaluate  a  box  arrangement  of  pixel  nodes 

70 

!  for 

the  displacement  fields  and  resultant 

dielectric  response 

80 

i  of 

a  composite  where  nodes  and  pixels  are 

co-existent. 

90 

1 

S. 

Wallin,  June  1991 

100 

1  *  _ 

* 

_*  —  *  —  *  —  * 

110 

CLEAR  SCREEN 

120 

PRINT  " 

Date:  " ; DATES (TmO ) ;RPT$ ( "  ",48);"Time: 

TIME? (TmO) 

130 

PRINT  " 

";RPT$("  >  ” , 7 ) ; . DIEL  SIM . ;RPT$( 

A 

3 

O' 

A 

140 

PRINT  RPT$ ( "  " , 56 ) ; " ( S .  Wallin,  June  1991)" 

150 

PRINT 

160 

PRINT  " 

This  program  ""DIEL  SIM"”  simulates  a  dielectric  composite: 

170 

PRINT  " 

a  box  represented" 

180 

PRINT  " 

as  an  interconnected  electrical  network 

.  The  displacement  field 

190 

PRINT  " 

(in  analogy  to  " 

200 

PRINT  " 

current)  is  a  continuous  quantity. 

The 

electric  field  is  the"; 

210 

PRINT  " 

voltage  drop  gra-" 

220 

PRINT  " 

dient  along  the  displacement  field  path 

segments. " ; 

230 

PRINT  " 

Schematically,  each  pixel  is" 

240 

PRINT  " 

cross  joined  between  faces  with  a  node. 

•l 

250 

PRINT  " 

• 

. 

w 

260 

PRINT  " 

Paths 

••  • 

•  9 

270 

PRINT  " 

Node  at" 

280 

PRINT  " 

connect 

»•  * 

•  9 

290 

PRINT  " 

center" 

300 

PRINT  " 

faces 

l* 

310 

PRINT  " 

• 

»• 

320 

PRINT  '' 

•  •  •  • 

M 

330 

PRINT  " 

The  pixels  are  then  interconnected  into 

a  nodal  network." 

340 

PRINT  " 

< 

-<  Exciter  electrode" 

3  50 

PRINT  " 

=  =  =  = 

=  =  =" 

360 

WAIT  .1 

370 

PRINT  " 

+  +  + 

+  + 

+  " 

380 

WAIT  .1 

390 

PRINT  " 

X  plane  +  +  + 

+  + 

+  "; 

400 

PRINT  " 

Y  across" 

410 

WAIT  .1 

420 

PRINT  " 

on  page  +  +  + 

+  + 

+  "; 

430 

PRINT  " 

Z  to/ from" 

440 

WAIT  .1 

450 

PRINT  " 

surface  +  +  + 

+  + 

460 

PRINT  " 

electrodes" 

470 

WAIT  .1 

480 

PRINT  " 

-  =  = - = 

:  =  =  = 

===•• 
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490 

500 

510 

520 

530 

540 

550 

560 

570 

580 

590 

600 

610 

620 

630 

640 

650 

660 

670 

680 

690 

700 

710 

720 

730 

740 

750 

760 

770 

780 

790 

800 

810 

820 

830 

840 

850 

860 

870 

880 

890 

900 

910 

920 

930 

940 

950 

960 

970 

980 

990 

1000 

1010 

1020 


WAIT  .1 

PRINT  M  |  <—  c  Ground  electrode" 

PRINT  "Initial  memory  is" ; PROUND (Mem0/16 , 2 ) ; 

PRINT  "(available  as  complex  number  storage  units)." 

PRINT  "(Hint:  Use  up/down  arrow  keys  to  scroll  on  CRT  when  paused"; 


PRINT  ”  ( halt=Clear" 

PRINT  "I/O  &  Stop,  break=Pause  &  Stop).]" 

1  DATA  ! 

!  Data  is  for  use  as  default  permittivities  ! 

DATA  1,0,2,2,4,6,5,8,6,16,7,32,8,64,9,128 
1  *-*-*-*-*-*-*-*-*-*-*-*  ! 
I  COMmon  Memory  ! 


COM  /Info/  INTEGER  Dsrc , Kond , Ptrn , Kn j , Spcs , Meth, Back, Sg j , Svr , Fln$ [ 80 ) , Msd$ ( 60 ) , COMPL 
Diet (0:9) 

COM  /Pass/Relay (0: 7 ) 

COM  /Pixel/  INTEGER  Xmax , Ymax , Zmax , Pixl ( 1 : 8000) , REAL  Xscl , Yscl , Zscl 
COM  /Memr /Graf ( 1 : 512, 1 :8) ,Ahdr$ [ 80] , Bhdr$[ 80] , INTEGER  Rep,Kwd 
COM  /Tit les/Chdr$ ( 80 ] , Dhdr$ [ 80 ] 

I  *_*_*_*_*_★_*_*  —  *  —  *  —  *  —  *  I 

!  VARIABLES  ! 

INTEGER  Xadr , Yadr , Zadr , Xcnt , Ycnt , Zcnt 

INTEGER  Axs, Dtl , Face, Inf c, Lpiv, Hdig, Hedge, Hlmt , Hmem, Hrel , Hrow, Helm, Hcnt 
INTEGER  Ndl , Nd2 , Ndmax , Nmr , Nwrk, Ovr , Rcyc , Rman , Rptr , SpcO , Zxy 

REAL  Iterr , Meml , Ntrt , Norm, Tml , TmvO, Tmvl , Tmcyc, Tmup, Xadm, Yadm, Zadm, Frk ( 0 : 9 ) 

COMPLEX  Admt 0 , Admt 1 , Admt 2,Alph,Hnrm,Resp 
DIM  Trs$ (40) ,Ws$[250] 

!  COM  /Info/  variable  descriptions: 

!  Dsrc  =  Dielectric  or  permittivity  selection 

!  Kond  =  boundary  condition  1)  Insulative  2)  Periodic  or  wrap  around 
!  Ptrn  =  Pixel  fill  pattern  choice 

!  Kn j  =  permittivity  conjugation,  0=none  l=alternating  2=averaged 
!  Spcs  =  number  of  species  or  types 

!  Meth  =  nodal  analysis  method  l=classic  2=sparseness  advantage 
!  Back  =  backsubtition  indicator  0=off  l=on 
!  Sgj  =  conjugation  state  +1  or  -1 
!  Svr  =  flag  to  save  output  on  a  file 
!  Fln$  =  name  of  file 
!  Msd$  =  name  of  mass  storage  device 
!  Dlct(*)  =  array  of  complex  dilectric  values 

!  COM  /Pass/  Relay  passes  information  to  SUBprograms  with  8  reals 
!  COM  /Pixel/  variable  descriptions: 

!  Xmax, Ymax, Zmax  =  greatest  of  each  pixel  address  extent 
!  Pixl(*)  =  integer  array  of  pixel  species  for  dielectric  types 
!  Xscl , Yscl , Zscl  =  real  scaling  factors 
!  COM  /Memr/  variable  descriptions: 

!  Graf(*)  =  a  data  output  storage  array  kept  after  program  run 
!  Ahdr$  =  1st  title  line  for  output  description 
!  Bhdr$  =  2nd  title  line  for  output  description 

!  Rep  =  integer  of  number  of  repeats  or  length  of  array  Graf(*) 

!  Kwd  =  integer  of  width  of  array  Graf(*) 

!  Variables  in  the  MAIN  program: 

!  Xadr , Yadr , Zadr  =  integer  pixel  addresses  in  (X,Y,Z)  coordinates 
!  Xcnt , Ycnt , Zcnt  =  pixel  counter  addresses  in  (X,Y,Z)  coordinates 
!  Axs  =  1,2,3  <=>  X , Y , Z  directions 


74 


1030  !  Dtl  =  0  to  surpress  1  to  print,  nodal  analysis  details 

1040  !  Face  =  integer  for  3D  axis  selection  or  sector 

1050  !  Infc=  interfaces  tally 

1060  !  Lpiv  =  pivoting  occurances 

1070  !  Hdig  =  a  counter  used  for  hopper/sparse  nodal  analysis 

1080  !  Hedge  =  #  along  edge  of  hopper/sparse  nodal  analysis  technique 

1090  !  Hmem  =  hopper  storage  requirement 

1100  !  Hrel , Hrow, Helm, Hcnt  =  row  &  column  addresses  in  hopper/sparse  tech 

1110  !  Ndl  =  integer  of  primary  node  address 

1120  !  Nd2  =  integer  of  a  node  adjoining  primary  node 

1130  !  Ndmax  =  node  maximum  =  l+Xmax*Ymax*Zmax 

1140  !  Nwrk  =  work  integer 

1150  !  Ovr  =  integer  indicating  for  overwrite/append  output  file 

1160  !  Rcyc  =  integer  flag  to  reuse  COM  /Info/  variables  as  input 

1170  !  Rman  =  manual  flag  0=OFF  1=0N 

1180  !  Rptr  =  integer  overall  repeat  counter 

1190  !  SpcO  =  integer  used  in  determining  species  limit 

1200  !  Zxy  =  integer  number  of  pixels  on  a  Z  plane,  Xmax*Ymax 

1210  !  Ntrt  =  real  number  of  integer  value  for  sparseness  memory  array 

1220  !  Norm  =  real  normalization  constant,  Zmax/Xmax/Ymax 

1230  !  Frk(»)  =  real  array  of  volume  fractions  of  different  types 

1240  !  Admt0,Admtl,Admt2  =  complex  admittance  paths 

1250  !  Alph  =  series<=>parallel,  Wiener,  or  exponential  averaging  factor 

1260  !  Hnrm  =  normalizing  element  for  hopper  pivoting 

1270  !  Resp  =  resultant  permittivity 

1280  !  Trs$,Ws$  =  work  string  of  40  chars, 250 

1290  !  Variable  arrays  to  be  ALLOCATED 

1300  !  Actl ( * ) , Act2 ( * )  =  complex  nodal  interaction  array 

1310  !  Teal ( * ) , Tca2 ( * )  =  complex  inverse  of  nodal  interactoin  array 

1320  !  Ptn(*)  =  complex  potentials  (w/  backsubstition) 

1330  !  Endex ( * )  =  complex  exciter  interactions  (w/  backsubstition) 

1340  !  Iterr  =  real  iteration  error 

1350  !  Meml,Mem0  =  real  available  internal  memory  for  program 

1360  !  TmO,Tml,TmvO,Tmvl,Tmcyc,Tmup  =  real  start  and  stop  times 

1370  !  Xadm, Yadm, Zadm  =  pixel  face  admittance  factors 

1380  IF  Zmax>0  THEN  !  presumably  now  a  rerun 

1390  LET  Rcyc=0 
1400  IF  Kond>0  THEN 

1410  INPUT  "Rerun  at  previous  settings?  0=no  l=yes  (default=0)  ”,Rcyc 

1420  END  IF 

1430  IF  Rcyc<0  THEN  STOP  Ipanic  stop 

1440  LET  Rcyc= ( Rcyc>0 ) 

1450  END  IF 

1460  IF  Rcyc  THEN  !  reuse  previous  inputs,  Rcyc=l 

1470  LET  Zxy=Xmax*Ymax  1  Pixs  on  a  Z  level 

1480  LET  Ndmax=Zxy*Zmax+l  !  Exciter  node 

1490  LET  Xadm=Y3cl*Zscl/Xscl  !  X  face  admittance  factor 

1500  LET  Yadm=Xscl*Zscl/Yscl  !  Y  face  admittance  factor 

1510  LET  Zadm=Xscl*Yscl/Zscl  1  Z  face  admittance  factor 

1520  LET  Norm=Zmax/Zadm/Zxy  !  Normalization  for  permittivity 

1530  PRINT  "From  COM  /Memr/  pixel  array  is” ; Xmax ; "x" ; Ymax ; "x  " ; VAL$ ( Zmax ) ; " . 

1540  IF  Xmax<=0  OR  Ymax<=0  OR  Zmax<=0  THEN  LET  Rcyc=0 

1550  LET  Ws$= " " 

1560  FOR  Xcnt=l  TO  Spcs  1  set  up  a  current  title 

1570  LET  Ws$=Ws$&"  (  "&VALS  ( Xcnt )  &  "  ] s 
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1580  LET  Ws$=Ws$&"  (  "&VAL$  (DROUND  ( REAL  (Diet  ( Xent )  )  ,  3  )  ) 

1590  LET  Ws$=Ws$&" , " &VAL$ ( DROUND ( I MAG (Dlct(Xcnt) )  ,3) )  6” ) " 

1600  NEXT  Xent 

1610  LET  Ycnt=MIN ( LEN ( Ws$ ) ,  75  ) 

1620  LET  Ahdr$="Diels  "&Ws$ [ 1 ; Yent ] 

1630  LLSE  1  get  new  input  info,  Rcyc=0 

1640  LET  Nwrk=0 

1650  DISP  ”IO  to  be  0)  default  1)  lab  2)  hardisk  3,4)  office  5)  user  defined 

1660  INPUT  "  (default=0)  ",Nwrk 

1670  SELECT  Nwrk 

1680  CASE  <0 

1690  STOP 

1700  CASE  =0 

1710  LET  Msd$= " " 

1720  CASE  =1 

1730  LET  Msd$=" :CS80, 700, 1 “ 

1740  CASE  =2 

1750  LET  Msd$=" :CS80, 700, 0” 

1760  CASE  =3 

1770  LET  Msd$=" :CS80, 700,0" 

1780  CASE  =4 

1790  LET  Msd$=" :CS80, 703, 1" 

1800  CASE  =5 

1810  LINPUT  "Name  your  storage  device_  ",Msd$ 

1820  CASE  ELSE 

1830  DISP  "Mass  storage  selection  too  big  for  menu,  defaults" 

1840  LET  Msd$= " " 

1850  END  SELECT 

1860  IF  Msd$<>" "  THEN  PRINT  RPT$ ( "  ”,48), -"mass  storage  device  ";Msd$ 

1870  PRINT  "Indicate  Pixel  fill  pattern:" 

1880  PRINT  "  0)  internal,  via  COM  /Memr/" 

1890  PRINT  "  1)  from  file  storage" 

1900  PRINT  "  2)  band  fill,  (tedious)" 

1910  PRINT  "  3)  random,  basic  shuffle  of  pixel  iso-sized  grains" 

1920  PRINT  "  4)  random,  shuffle  with  dual  blocking" 

1930  PRINT  "  5)  ellipsoid,  (semi-model  of  effective  medium  theory)" 

1940  PRINT  "  6)  correlation,  (exponential,  power  laws)" 

1950  PRINT  ”  7)  fractal  with  evolution  by  successive  generations” 

1960  PRINT  "  default  is  currently  " ; VAL$ ( Ptrn ) ; " . " 

1970  LET  Ndl=Ptrn  !  keep  track  of  previous 

1980  IF  Kond=0  THEN  Ptrn=3 

1990  DISP  "Pixel  fill  selection?  ( def ault=" ; VAL$ ( Ptrn ) ; 

2000  INPUT  ")  " , Ptrn 

2010  IF  Ptrn<0  THEN  STOP 

2020  IF  PtrnoNdl  THEN  MAT  Relay=(0)  1  zero  upon  Ptrn  change 

2030  SELECT  Ptrn 

2040  CASE  =0 

2050  IF  Xmax<=0  OR  Ymax<=0  OR  Zmax<=0  THEN 

2060  DISP  "May  have  memory  error,  pixel  box  measures 

2070  DISP  VAL$ ( Xmax ) ; "x" ; VAL$ ( Ymax ) ; "x" ;VAL$ ( Zmax ) 

2080  STOP 

2090  END  IF 

2100  PRINT  "The  pixels  are  from  internal  memory  and  measure 

2110  PRINT  VAL$ ( Xmax ); "x VAL$ ( Ymax );"x";VAL$( Zmax) 

2120  CASE  -1 
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2130  LINPUT  "File  source  name  for  Pixels?  ",Fln$ 

2  140  IF  F 1  n  $  =  "  "  THEN  STOP 

2150  IF  POS<  Fln$,  "  :  "  )  =0  THEN  Fln$=Fln$S.Msd$ 

2160  DISP  "File  . ;Fln$;' .  is  being  read  from  storage" 

2170  ASSIGN  @Pxsrc  TO  Fln$ ; FORMAT  OFF 

2180  ENTER  @Pxsrc; Ahdr$ ; BhdrS ; Xmax ; Ymax; Zmax; Xscl ; Yscl ; Zscl 

2190  IF  Xmax<=0  OR  Ymax<=0  OR  Zmax<=0  THEN 

2200  DISP  ""'"';Fln$; .  may  have  error,  pixel  box  measures  "; 

2210  DISP  VALS (Xmax) ; "x" ;VALS (Ymax) , "x";VAL$ (Zmax) 

2220  ASSIGN  @Pxsrc  TO  * 

2230  STOF 

2240  END  IF 

2250  IF  Xmax<=0  OR  Ymax<=0  OR  Zmax<=0  THEN  PRINT  Xmax ; ”x" ; Ymax ; "x" ; Zmax ? 

2260  t’OR  Xcnt  =  l  TO  Xmax*Ymax*Zmax 

2270  ENTER  @Pxsrc ; Pixl ( Xcnt ) 

2280  NEXT  Xcnt 

..90  ASSIGN  @Pxsrc  TO  * 

2300  END  SELECT 

2310  IF  Ptrn>2  THEN  ! get  Pixel  limits  from  user 

2320  IF  Xmaxcl  THEN  Xmax=l 

2330  DISP  "Give  X  pixel  limit,  (how  many  X  planes,  default=" ; VAL$ (Xmax ) ; 

2340  INPUT  ")?  " , Xmax 

2350  IF  Xmax<0  THEN  STOP 

2360  IF  Xmax=0  THEN  Xmax=l 

2)70  IF  Ymax< 1  THEN  Ymax=l 

2380  DISP  "Give  Y  pixel  limit,  (how  many  Y  columns/plane, " ; 

2390  DxSP  "  de fau lt="; VAL$ ( Ymax ) ; 

2400  INPUT  ";?  " , Ymax 

2410  IF  Ymax<0  THEN  STOP 

2420  IF  Ymax=0  THEN  Ymax=l 

2430  IF  Zmax< 1  THEN  Zmax=l 

2440  DISP  “Giv  Z  pixel  limit,  ftov  many  Z  rows  between  electrodes,"; 

2450  DISP  "  default  ";VAL$(Zm  ; 

2460  INPUT  ")?  " , Zmax 

2470  IF  Zmax<0  THEN  STOP 

2480  IF  Zmax=0  THEN  Zmax=l 

2490  IF  Xscl<=0  THEN  Xscl=l 

2600  DISP  "Give  X  pixel  scale  factor  ( >0  to  inf,  def ault= " ; VAL$ ( Xscl ) ; 

2510  INPUT  ")?  " , Xscl 

2620  IF  Xsc 1 <0  THEN  STOP 

2630  IF  Xscl=0  THEN  Xscl=l 

2 M0  IF  Y s c  1  <  =  0  THEN  Yscl  =  l 

2660  DISP  "Give  Y  pixel  scale  factor  ( >0  to  inf,  default=" ; VAL$ ( Yscl ) ; 

2660  INPUT  ")?  " , Yscl 

2  6  70  IF  Y s c 1 < 0  THEN  STOP 

2680  IF  Ysc 1 =0  THEN  Yscl=l 

2690  IF  Zscl<=0  THEN  Zscl=l 

2600  DISP  "Give  Z  pixel  scale  factor  (>0  6 _  inf,  default=” ; VAL$ ( Zscl ) ; 

2610  INPUT  ")?  " , Zscl 

2620  IF  Zscl<0  THEN  STOP 

2630  IF  Zsc  1  =0  THEN  Zscl=-1 

2640  END  IF  lend  if  for  Ptrn>2  test 

2660  PRINT  "  The  scale  factors  are:  X ' s=" ; VAL$ ( DROUND ( Xsc 1 , 4 ) ) ; 

2660  PRINT  ",  Y ' s=" ;VAL$ (DROUND (Yscl , 4 ));" ,  &  Z ’ s= VALS ( DROUND ( Zsc 1 , 4 ) ) 

2670  IF  Kond=0  THEN  Kond=l 
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2680  DISP  "Boundary  conditions?  1)  Insulated  2)  Periodic  or"; 

2690  DISP  "  wrap  around  (def ault=" ;VAL$ (Kond) ; 

2700  INPUT  ")  " , Kond 

2710  IF  KondcO  THEN  STOP 

2720  LET  Kond= ( Kond>l ) +1 

2730  LET  Spc0=9  i  overall  species  limit  set  at  9 

2740  IF  Spcs=0  THEN  Spcs=2  1  binary  species  default 

2750  DISP  "How  many  species  overall?  ( <= " ; VAL$ ( SpcO ) ; " , def ault=” ; VAL$ ( Spce ) 

2760  INPUT  ” ) " , Spcs  I  later.,  incl  option  for  subspecies 

2770  IF  Spcs<0  THEN  STOP  1  panic  stop 

2780  IF  Spcs=0  THEN  Spcs=2  !  default  to  binary  composite 

2790  IF  Spcs>Spc0  THEN  Spcs=9  !  reset  to  programming  limit 

2800  IF  Diet ( 1 ) =CMPLX (0,0)  THEN  LET  Dsrc=l  Idefault 
2810  DISP  "Permittivi'- ies  from?  0=intrnl  mem  l=prog  2=user  "; 

2820  IF  Spcs=2  THEN  DISP  "3=binary  insl/cond 

2830  DISP  ” (def ault=" ; VAL$ ( Dsrc ) ; 

2840  INPUT  " ) " , Dsrc 

2850  IF  Dsrc<0  THEN  STOP 

2860  IF  Dsrc>3  THEN  Dsrc=2 

2870  IF  Dsrc>0  THEN  LET  Sgj=l  !  reset  conjugation  state  to  fresh=+l 

2880  SELECT  Dsrc 

2890  CASE  =1 

2900  FOR  Xcnt= 1  TO  Spcs 

2910  READ  Diet ( Xcnt ) 

2920  NEXT  Xcnt 

2930  CASE  =2 

2940  FOR  Xcnt=l  TO  Spcs 

2950  DISP  "Complex  permittivity  for  species  [ " ; VAL$ ( Xcnt ) ; 

2960  DISP  "]s  ( previous= ( " ; VAL$ (DROUND ( REAL ( Diet ( Xcnt ) ) , 4 ) ) ; ", " ; 

2970  DISP  VAL$ ( DROUND ( I MAG ( D1 ct ( Xcnt )), 4 ));"))" ; 

2980  IT  " , Diet (Xcnt ) 

2990  NEXT  Xcnt 

3000  CASE  =3 

3010  FOR  Xcnt=l  TO  Spcs 

3020  IF  BIT(Xcnt, 0) =0  THEN 

3030  LET  Iterr=REAL (Diet ( Xcnt ) ) 

3040  DISP  "For  the  species  [ ” ; VAL$ ( Xcnt ) ; ” ] ,  give  the  real  part?"; 

3050  DISP  ”  ( previous=" ;  VAL$ ( DROUND ( Iterr , 4 ) ) ; 

3060  INPUT  ")  ", Iterr 

3070  LET  Diet ( Xcnt ) =CMPLX ( Iterr , 0 ) 

3080  ELSE 

3090  LET  Iterr=IMAG ( Diet (Xcnt ) ) 

3100  DISP  "For  the  species  [ " ; VAL$ ( Xcnt ) ;  j,  give  the  imaginary"; 

3110  DISP  "  (loss)  part?  ( prev ious  =  " ; VAL$ ( DROUND ( I  ter r , 4 ) ) ; 

3120  INPUT  ")  ", Iterr 

3130  LET  Dlct(Xcnt) =CMPLX ( 0 , Iterr ) 

3140  END  IF 

3150  NEXT  Xcnt 

3160  END  SELECT 

3170  IF  Meth=0  THEN  Meth=2 

3180  DISP  "Select  nodal  analysis  method  1)  classic  matrix"; 

3190  DISP  "  2)  sparse  advantage  (default=" ;VAL$ (Meth) ; 

3200  INPUT  ")  ” , Meth 

3210  IF  Meth<0  THEN  STOP  Ipanic  stop 

3220  LET  Meth= 1 + ( Meth>l ) 
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3230 
3240 
3250 
3260 
3270 
3280 
3290 
3300 
3310 
3320 
3  330 
3340 
3350 
3  360 
3370 
3380 
3390 
3400 
3410 
3420 
3430 
344C 
3450 
3460 
3470 
3480 
3490 
3500 
3  6  10 
3520 
3  5  30 
3540 
3550 
3560 
3570 
3580 
3  690 
3600 
3b  10 
3620 
3  b  3  0 
3640 
3650 
3660 
36  70 
3680 
3690 
3700 
3710 
3720 
3730 
3740 
3  7  50 
3  760 
3  7  70 


DISP  "Backsubstrtution,  ie  backchecking  &  field  mapping? 

DISP  "0=no  l=yes  (def ault=" ; VAL$ ( Back) ; 

INPUT  ")” ,Back 
IF  BackcO  THEN  STOP 
LET  Back= ( Back>0 ) 

DISP  "How  many  repeats?  (default3" ;VAL$ (Rep) ; 

DISP  ",  0=manual ,  ” ; VAL$ ( SiZE (Graf , 1 ) ) ; "=max  prog)"; 

INPUT  "  ",Rep 
IF  Rep<0  THEN  STOP 
LET  Ws$=" " 

FOR  Xcnt=l  TO  Spcs  1  set  up  title 

LET  Ws$=Ws$& " ( "&VAL$ ( Xcnt )  &" ) s " & "=" 

LET  Ws$=Ws $&" ( "&VAL$(DROUND( REAL (Diet (Xcnt) ) ,3) ) 

LET  Ws$=Ws$& " , "&VAL$ ( DROUND ( I MAG ( Diet ( Xcnt ) ) ,3) )&")" 

NEXT  Xcnt 

LET  Xcnt =M IN ( LEN ( Ws$ ) , 75 ) 

LET  Ahdr$="Diels  "&Ws$ { 1 ; Xcnt ] 

IF  Rep>l  THEN 

DISP  "Conjugate  pairing  (by  2s)?  0=no  l=alternating  2=averaged  ” 
DISP  " (default3" ;VAL$ (Knj ) ; " ) ”  ; 

INPUT  "  ",Knj 
IF  Knj<0  THEN  STOP 
IF  Knj >2  THEN  Knj=0 

DISP  "Save  repeat  information  in  a  file?"; 

DISP  "  0=no  l=yes  (default3" ;VAL$ (Svr ) ; 

INPUT  ")  " , Svr 

IF  Svr<0  THEN  STOP  !  panic  stop 

LET  Svr= ( Svr>0 ) 

IF  Svr  THEN 

LET  fcj$=Fln$  !for  a  suggested  file  naming 

IF  Ptrn>0  THEN 

IF  Ptrn=l  THEN  Fln$="S" 

IF  Ptrn=2  THEN  Fln$="H" 

IF  Ptrn=3  THEN  Fln$="G" 

IF  Ptrn=4  THEN  Fln$="B" 

IF  Ptrn=5  THEN  Fln$=”E" 

IF  Ptrn=6  THEN  Fln$="K" 

IF  Ptrn=7  THEN  Fln$="F" 

LET  Xcnt=MIN ( Xmax , Xmax , Zmax ) 

LET  Xcnt=MAX ( Xmax , Xmax , Zmax ) 

IF  Xcnt=Xcnt  AND  Xmax>9  THEN 
Fln$  =  Fln$S«"3D"ScVAL$  ( Xmax ) 

ELSci 

LET  Fln$=Fln$&VAL$ ( Xmax ) &VAL$ ( Xmax ) &VAL$ ( Zmax ) 

END  IF 

IF  Kond=l  THEN  Fln$=Fln$&"S" 

IF  Kond=2  THEN  Fln$=Fln$&"P" 

END  IF  I  end  if,  new  suggested  filename 

IF  Ptrn>2  THEN 

IF  Diet ( 2 ) OCMPLX (0,0)  THEN  Admtl=LOG ( Diet ( 1 ) /Diet ( 2 ) ) 

LET  Admt 1=CMPLX ( REAL ( Admt 1 ) /LOG ( 10 ) , IMAG ( Admt 1 )* 180/PI )* 1000 
LET  Trs$=VAL$ ( ABS ( REAL ( Admt 1 ) ) ) 

IF  ABS ( REAL ( Admt 1 ) ) <1000  THEN  Trs$="0"&Trs$ 

LET  Fln$=Fln$&Trs$ ( 1 ; 2 ] 

LET  Trs$=VAL$( ABS ( IMAG ( Admt 1 ) ) ) 
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3780 

3790 

3800 

3810 

3820 

3830 

3840 

3850 

3860 

3870 
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IF  ABS(REAL(Admtl) )<900  THEN  Trs$="0"&Trs$ 

LET  Fln$=Fln$&Trs$ ( 1 ; 1 ] 

END  IF 

OUTPUT  KBD/Fl n$; 

DISP  "Verify  or  name  file  to  receive  output  (change  &  enter"; 

IF  Ws$<>""  THEN  DISP  "  or  type  old=""";Ws$; . ' ; 

LINPUT  ”)  " , Fln$ 

OUTPUT  KBD ; Ahdr $ ; 

DISP  "Verify  or  enter  a  title?  (<80”; 

IF  Ahdr $<>" "  THEN  DISP  ",  prev  run=" ; Chdr$ ; 

LINPUT  ")  " , Ahdr$ 

END  IF  !  end  if  for  Svr 

ELSE 


LET  Kn j=0 
END  IF 
END  IF 

LET  Rman=(Rep=0) 

IF  Svr  AND  Fln$=" "  THEN  Svr=0 
IF  Svr  THEN 

IF  POS(Fln$, " : " )=0  THEN  Fln$  = 
ON  ERROR  GOTO  4090 
ASSIGN  @Exist  TO  Fln$ 

ASSIGN  @Ex ist  TO  * 

OFF  ERROR 


1  if  no  repeats,  then  no  conjugation 
1  end  if  for  Rep>0 

!  end  if  for  Rcyc=0 

1  manual  switch 

1  if  nothing  change  to  NO  filing 
!  anticipate  save  output  to  file 

n$&Msd$  !add  mass  storage  specifier 

!  error  means  branch  to  new  file 


LET  Ovr=0 

DISP  ; F 1 n $ ; ” " ”  exists.  Select;  0=ekip  filing  l=overwrite" ; 

INPUT  "  2=append  ",Ovr 
IF  Ovr<0  THEN  STOP 
IF  Ovr>2  THEN  Ovr=0 
IF  Ovr=0  THEN  Svr=0 

GOTO  4120  !  branch  to  end  file  check 

LET  Ovr=3  I  create  output  file 

OFF  ERROR 
ASSIGN  @Ex ist  TO  * 


REM  end  of  file  existance  checking 


Pixel  pattern  = 
! 


END  IF 

PRINT  "Selections 
LET  Zxy=Xmax*Ymax 
LET  Ndmax=Zxy*Zmax+l 
LET  Xadm=Yscl*Zscl/Xscl 
LET  Yadm=Xscl *Zscl/Yscl 
LET  Zadm=Xscl*Yscl/Zscl 
LET  Norm=Zmax/Zadm/Zxy 
PRINT  "The  box  measures Xmax ;" x Ymax ; "x" ; Zmax ; "pixel s  giving"; 
PRINT  Ndmax-1; "total." 

PRINT  "There  is  a  node  for  each  pixel  plus  the  exciter  electrode, 
PRINT  "  in  all  " ; VAL$ ( Ndmax) ; " . " 

LET  Dt 1=0  IDefault  to  no  detail 

IF  Ndmax<37  AND  Rman  THEN 


1  end  if  to  Svr=save  output  to  file 
;Ptrn Boundary  condition  =";Kond 
Max  nodes  residing  on  a  Z  level 
Exciter  node  number 
X  face  admittance  factor 
Y  face  admittance  factor 
Z  face  admittance  factor 
Normalization  value 


so"  ; 


DISF  "View/check  nodal  ”; VAL$ (Ndmax }; "x" ;VAL$ (Ndmax ) ; "  analysis"; 
INPUT  ”  details?  0=no  l=yes  (default=0)  ”,Dtl 
IF  Dt 1<0  THEN  STOP 
LET  Dtl= ( Dt 1>0 ) 

END  IF  !  end  if  Rep=l  &  Ndmax  condition 

IF  Dt 1  THEN 
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4330  PRINT  "Nodal  analysis  numbering  scheme" 

4340  FOR  Xcnt=l  TO  Xmax 

4350  PRINT  RPT$(”  ",  SHIFT (Ymax, -1 )); "X=" ;VAL$ (Xcnt ) 

4360  FOR  Zcnt=Zmax  TO  1  STEP  -1 

4370  FOR  Ycnt=l  TO  Ymax 

4380  LET  Nwrk=FNOde_mk(Xcnt, Ycnt , Zcnt , Xmax, Ymax, Zmax) 

4390  PRINT  USING  "4D,#";Nwrk 

4400  CALL  Node_addrs(Nwrk,Xadr, Yadr, Zadr, Xmax, Ymax, Zmax) 

4410  IF  XadroXcnt  OR  YadroYcnt  OR  ZadroZcnt  THEN 

4420  PRINT  " 

4430  IF  XcntoXadr  THEN  PRINT  "X"  ;  VAL$  ( Xcnt )  ;  "  "  "  ;  VAL$  ( Xadr )  ; 

4440  IF  YcntoYadr  THEN  PRINT  ”Y  "  ;VAL$  ( Ycnt );  VAL$  ( Yadr )  ; 

4450  IF  ZcntoZadr  THEN  PRINT  "  Z”  ;VAL$  (  Zcnt );  ;VAL$  (  Zadr )  ; 

4460  PRINT 

4470  END  IF 

4480  NEXT  Ycnt 

4490  PRINT 

4500  NEXT  Zcnt 

4510  NEXT  Xcnt 

4520  END  IF 

4530  IF  Meth=l  THEN  ! Initialize  nodal  analysis  arrays 

4540  ALLOCATE  COMPLEX  Actl ( 1 : Ndmax , 1 : Ndmax ) , Teal ( 1 : Ndmax , 1 : Ndmax ) 

4550  ALLOCATE  COMPLEX  Ptn ( 1 : Ndmax ), Endex ( 1 : Zxy+1 ), Fluz ( 1 : Ndmax-1 ) 

4560  LET  Ntrt=2 . 0*Ndmax*Ndmax+Ndmax  Inumber  of  storage  elements 

4570  ELSE 

4580  LET  Hedge=Zxy+l  ledge  units  along  side  of  nodal 

4590  LET  Hmem= ( 1 . 0+Hedge) ‘Hedge* . 5  lanalysis  hopper  overall  #=Hmem 

4600  ALLOCATE  COMPLEX  Hpiv ( 1 : Hedge ), Act2 ( 1 : Hmem ) 

4610  LET  Ntrt= ( 1 . 0+Ndmax ) * Ndmax* . 5  IMax  nodal  storage  requirement 

4620  ON  ERROR  GOTO  4670  [Branch  on  error  to  NO  backsub 

4630  ALLOCATE  COMPLEX  Tca2 ( 1 : Hedge-1 , 1 : Ndmax-1 ), Ptn ( 1 : Ndmax ) 

4640  ALLOCATE  COMPLEX  Endex ( 1 : Hedge ), Fluz ( 1 : Ndmax-1 ) 

4650  GOTO  4710  lelse  error  occured 

4660  IF  Back= 1  THEN 

4670  PRINT  "Memory  too  small  to  save  for  backsubtitution, " ; 

4680  PRINT  "  thus  NO  BACKCHECKING  or  NO  POTENTIALS." 

4690  END  IF 

4700  LET  Back=0  ! no  backsubBtituting 

4710  OFF  ERROR 

4720  END  IF 

4730  !  =  =  =  =  NODAL  ANALYSIS 

4740  LET  Kwd  =  SI ZE ( Gra f , 2 )  1  row  size  of  Graf  storage 

4750  MAT  Graf=(0)  1  initialize  Graf  storage 

4760  IF  Ptrn=2  THEN  MAT  Relay=(0)  l  zero  Relays  for  manual  fill 

4770  LET  Tmcyc=TIM£DATE  !  start  cycle  timer 

4780  FOR  Rptr=l  TO  SH I  FT ( Rep , - ( Kn j >0 ) ) +Rman !  repeat  cycles,  use  conjugation 
4790  IF  Meth-1  THEN  !  initialize  nodal  arrays  to  zero 

4800  MAT  Act  1  =  ( CMPLX (0,0)  ) 

4810  MAT  Teal = ( CMPLX (0,0) ) 

4820  ELSE 

4830  MAT  Act 2= ( CMPLX (0,0) ) 

4840  IF  Back  THEN  MAT  Tca2= ( CMPLX ( 0 , 0 ) ) 

4860  END  IF 

4860  !  FILL  PIXELS 

4870  IF  Ptrn>2  THEN  MAT  Pixl=(0)  !  initialize  pixel  array  to  zero 
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LET  Nd2=(Knj>0)  !  use  as  a  test  of  Knj  in  SELECT 

SELECT  Ptrn 
CASE  =2 

CALL  Pixs_by_hand 
CASE  =3 

IF  NOT  (Rcyc  OR  Rman)  AND  Rptr=l  THEN  I  if  multiple  calls  set  Relay (2) 
LET  Xadr=l 

INPUT  "Shuffle  along  the  X  direction?  0=no  l=yes  (default=l)  ",Xadr 
IF  Xadr<0  THEN  STOP 
LET  Xadr= ( Xadr=0 ) 

LET  Yadr=l 

INPUT  "Shuffle  along  the  Y  direction?  0=no  l=yes  (default=l)  ",Yadr 
IF  YadrcO  THEN  STOP 
LET  Yadr=(Yadr=0) 

LET  Zadr=l 

INPUT  "Shuffle  along  the  Z  direction?  0=no  l=yes  (default=l)  " , Zadr 
IF  Zadr<0  THEN  STOP 
LET  Zadr= ( Zadr=0 ) 

REM  Relay(0)  =  volume  fractions 
REM  Relay ( 1 ) =seed 

LET  Relay (2 ) =SHIFT ( Xadr , -2 ) +SHIFT ( Yadr , -1 ) +Zadr 
END  IF 
IF  Rman  THEN 


Relay ( 0 ) =0 
Relay ( 1 ) =0 
ELSE 

LET  Relay ( 0 ) =FRACT ( SHIFT ( Rptr+Nd2 , Nd2 ) / ( Rep+ 1 ) ) I vol  frac 
LET  Relay ( 1 ) =Rptr  !  pass  to  randomize  seed 

END  IF 

CALL  Pixs_by_random(Spcs) 

CASE  =4 

REM  Relay (0)  =  volume  fractions 
REM  Relay ( 1 ) =seed 
IF  Rman  THEN 
Relay ( 0 ) =0 
Relay ( 1 ) =0 
ELSE 

LET  Relay (0 ) =FRACT (SHI FT ( Rptr+Nd2 , Nd2 ) / ( Rep+1 ) ) ! vol  frac 
LET  Relay ( 1 )  =Rptr  pass  to  randomize  seed 


END  IF 

CALL  Pixs_by_2block ( Spcs ) 

CASE  =5 

REM  Relay(0)  =  volume  fractions 
REM  Relay ( 1 , 2 , 3 ) =el 1 ipse  axis 
REM  Relay (4) 

IF  NOT  Rcyc  AND  Rptr=l  AND  Rep>l  THEN 

DISP  "Inclusion  role?  0)=smaller  species,  1 
INPUT  "  2)=species  #2  ”,Relay(4) 

IF  Relay ( 4 ) <0  THEN  STOP 
LET  Relay ( 1 )=1 

INPUT  "Ellipsoid  X  axis  length?  (default=l) 
LET  Rel ay ; 2 ) = 1 

INPUT  "Ellipsoid  Y  axis  length?  (default=l) 
LET  Relay ( 3 ) = 1 

INPUT  "Ellipsoid  Z  axis  length?  (default=l) 


= species  #1 , " ; 


, Relay ( 1) 
, Relay ( 2 ) 
.Relay ( 3) 
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END  IF 
IF  Rman  THEN 
LET  Relay(0)=0 
ELSE 

LET  Relay ( 0 ) =FRACT ( SHIFT( Rptr+Nd2 , Nd2 ) / (Rep+1 ) ) 1 vol  frac 
END  IF 

CALL  Pixs_by_ellps 
CASE  =6 

REM  Relay (0)  =  volume  fractions 
REM  Relay ( 1 ) =seed 

REM  Relay ( 2 ) correlation  select,  0=f lat , l=exp, 2=inv, 3=inv  sqr,4=pwr 
REM  Relay ( 3 ) =correlat ion  length  or  power  law 

REM  Relay(4)=for  l=exp  then  correl  lenght,  for  4=pwr  then  power 
IF  NOT  Rcyc  AND  Rptr=l  AND  Rep>l  THEN 

DISP  "Corrrelation?  none=0  expon=l  inverse=2  inv  square=3"; 

DISP  "  power  law=4  (def ault=" ; VAL$ (Relay ( 2 ) ) ; 

INPUT  " ) " , Relay ( 2 ) 

IF  Relay ( 2 ) =1  THEN 

DISP  "Correlation  length?  (in  pixel  units,  default="; 

DISP  VAL$ ( Relay ( 3 ) ) ; 

INPUT  " ) " , Relay ( 3) 

END  IF 

IF  Relay ( 2 ) =4  THEN 

DISP  "Power  law?  (l=inverse  2=inv  square,  default="; 

DISP  VAL$ ( Relay ( 3 ) ) ; 

INPUT  " ) ” , Relay ( 3 ) 

END  IF 
END  IF 
IF  Rman  THEN 
Relay (0)=0 
Relay ( 1 )=0 
ELSE 

LET  Relay ( 0 ) =FRACT ( SHIFT ( Rptr+Nd2 , Nd2 ) / ( Rep+1 ) ) ! vol  frac 
LET  Relay ( 1 ) =Rptr  !  pass  to  randomize  seed 

END  IF 

CALL  Pix_by_correlat 
CASE  =7 

REM  Relay(0)  =  volume  fractions 
REM  Relay ( 1 ) =seed 

REM  Relay ( 2 ) =number  of  generations  of  evolving 
r  F  NOT  Rcyc  AND  Rptr=l  AND  Rep>l  THEN 

DISP  "Maintain  constant  parent  to  descendent”; 

DISP  "  ratios?  Vary=0  Fixed=l  ( def au 1 t=" ; VAL$ ( Relay ( 2 ) ) ; 

INPUT  " ) " , Rel ay ( 2 ) 

DISP  "Number  of  generations  of  evolution?"; 

DISP  "  (self  determine=0,  def au 1 t=” ; VAL$ ( Relay ( 3 ) ) ; 

INPUT  " ) " , Relay ( 3 ) 

DISP  "STARTER/CONVERGENCE  species?  ( def  ault  =  "  ;  VAL$  ( Rel  ay  (  4  )  )  ; 
INPUT  ")" .Relay (4) 

DISP  "What  is  fractional  chance  of  parents  descending"; 

DISP  "  to  other  species?  ( def au lt=" ; VAL$ ( FRACT ( Relay ( 5 ) ) ) ; 

INPUT  ” ) ” , Relay ( 5 ) 

END  IK 
IF  Rman  THEN 

LET  Relay ( 0 ) =0 
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LET  Relay (1)=0 
LET  Relay ( 2 ) =0 
LET  Relay ( 3 ) =0 
LET  Relay (4)=0 
LET  Relay (5)=0 
ELSE 

LET  Relay (0)=FRACT (SHIFT 
LET  Relay ( 1 ) =Rptr 
END  IF 

CALL  Pixs_by_evolv ( Spcs ) 

END  SELECT 
LET  Inf c=0 
MAT  Frk= ( 0 ) 

FOR  Nwrk=l  TO  Ndmax-1 

IF  Pixl ( Nwrk) >0  THEN  LET  Frk 
NEXT  Nwrk 


Rptr+Nd2 , Nd2 ) / (Rep+1 ) ) ! vol  frac 
1  pass  to  randomize  seed 


Unitialize  interface  tally 
! Initialize  volume  fractions 
ITally  up  pixel  types 
Pixl (Nwrk) ) =Frk ( Pixl ( Nwrk) ) +1 


MAT  Frk=Frk/ (Ndmax-1)  lconvert  to  vol  fractions 

IF  Rptr<3  THEN  iprint  out  pixel  array 

PRINT  "The  pixel  box  array Xmax ; "x" ; Ymax ; "x" ; Zmax ; 

PRINT  "contains  the  types:" 

FOR  Xcnt=l  TO  Xmax 

PRINT  RPT$ ( "  " , Ymax ) ; ”X=" ; VAL$ (Xcnt ) 

FOR  Zcnt=Zmax  TO  1  STEP  -1 


FOR  Ycnt=l  TO  Ymax 

LET  Nwrk=FNOde_mk ( Xcnt , Ycnt , Zcnt , Xmax , Ymax , Zmax ) 

PRINT  USING  "DD , ; Pixl (Nwrk) 

NEXT  Ycnt 
PRINT 
NEXT  Zcnt 
NEXT  Xcnt 
END  IF 

PRINT  "  Volume  fractions  are:  " 

FOR  Xcnt=l  TO  Spcs 

PRINT  ” [";VAL$(Xcnt);")s  have  " ; VAL$ ( DROUND ( Frk ( Xcnt ) , 4 ) ) ; 

IF  Xcnt<Spcs  THEN  PRINT 
NEXT  Xcnt 
PRINT 

PRINT  "Species  permittivities:  "; 

FOR  Xcnt=l  TO  Spcs 

PRINT  "  l " ;VAL$ (Xcnt ) ; "] s= ("; VAL$ ( DROUND ( REAL ( Diet ( Xcnt ) ) , 4) ) ; 
PRINT  VALS ( DROUND ( IMAG( Diet (Xcnt ) ) ,4) ) ) " ; 

NEXT  Xcnt 
PRINT 

IF  Dtl  THEN  PRINT  "Principal  node  &  participating  neighbor  nodes 
IF  Dtl  THEN  PRINT  "  Node  (  O)  touches"; 

LET  Hdig=l 

FOR  Nd2=l  TO  Zxy  1 Z= 1  level  nodes  touching  ground 

IF  Dtl  THEN  PRINT  USING  ""”  DD ; Nd2 

LET  Admt0  =  D lct(Pixl(Nd2))* Zadm I  only  path  admittance  to  ground 
IF  Meth= 1  THEN  LET  Act  1 ( Nd2 , Nd2 ) =Admt0 
IF  Meth=2  THEN  LET  Act2 ( Hd ig ) = AdmtO 

LET  Hd ig=Hdig+Nd2+ 1  ! 1 , 3 , 6 , 10 , 1 5 . .  diagonal  elements 

NEXT  Nd2 

IF  Dtl  THEN  PRINT 
IF  Meth=2  THEN 
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LET  TmvO=TIMEDATE  Iclock  nodal  analysis,  Meth=2 

DISP  "  . .wait, " ;Rptr; "of  " ;VAL$ ( SHIFT (Rep, - (Knj>0) ) +Rman ) ; 

DISP  ",  solve" ;Ndmax; "nodes  >@" ;TIME$(Tmv0) 

END  IF 

LET  Lpiv=0  lpivoting  occurances,  initialize 

LET  Hdig=l  11,3,6,10,15..  diagonal  elements 

FOR  Ndl  =  l  TO  Ndmax-1  IRange  thru  all  pixel  block  nodes 

IF  Dtl  THEN  PRINT  USING  """Node  [  "  "  ,  DD ,  ]  touches"  ;Ndl 
CALL  Node_addrs(Ndl,Xadr, Yadr, Zadr,Xmax, Ymax, Zmax) ! (X,Y, Z)  of  node 
LET  Admtl=Dlct ( Pixl (Ndl ) )  (Admittance  in  principal  node 
FOR  Axs=l  TO  3  ! ( 1 , 2, 3)<=>(x, y, z)  axes 

FOR  Face=0  TO  1  1  0=lower  l=upper  face  wrt  choosen  axis 

LET  Nd2=-1  llntialize  as  no  known  node 

IF  Face  THEN  1IF  Face(t)=l  (upper  face) 

SELECT  Axs 
CASE  =1 


IF  Xadr<Xmax  THEN  Nd2=Ndl+l  lordinary  neighbor 
IF  Xadr=Xmax  AND  Kond=2  THEN  Nd2=Ndl-Xmax+l  Iwrap  periodic  X 
CASE  =2 


IF  Yadr<Ymax  THEN  Nd2=Ndl+Xmax 

IF  Yadr=Ymax  AND  Kond=2  THEN  Nd2=Ndl-Zxy+Xmax  Iwrap  periodic 
CASE  =3 

IF  Zadr<Zmax  THEN  Nd2=Ndl+Zxy 

IF  Zadr=Zmax  THEN  Nd2=Ndmax  lexciter  electrode  is  neighbor 
END  SELECT 
ELSE 

SELECT  Axs 
CASE  =1 

IF  Xadr>l 
IF  Xadr=l 
CASE  =2 

IF  Yadr>l 
IF  Yadr=l 
CASE  =3 

IF  Zadr>l 
IF  Zadr=l 
END  SELECT 

END  IF  lend  if,  Face(t) 

IF  Dtl  THEN  PRINT  USING  .  ("", DD Nd2 

IF  Nd2>0  AND  Ndl<>Nd2  AND  Nd2<Ndmax  THEN  la  decent  neighbor 
LET  Admt2=Dlct ( Pixl (Nd2 ) ) lAdmittance 
LET  Admt0=Admtl+Admt2  1  path  admittance 

IF  Pixl (Ndl ) <>Pixl (Nd2 )  THEN  Infc=Infc+l  Itally  up  interfaces 
IF  AdmtOoCMPLX (0,0)  THEN 
LET  Admt0=Admt 1 *Admt2 /AdmtO 
IF  Axs= 1  THEN  AdmtO=AdmtO*Xadm 
IF  Axs=2  THEN  Admt0=Admt0*Yadm 
IF  Axs=3  THEN  Admt0=Admt0* Zadm 
IF  Meth= 1  THEN 

LET  Act l(Ndl,Ndl)=Actl(Ndl,Ndl) + AdmtO  iself  interact 
LET  Actl (Ndl , Nd2 ) =Act 1 (Ndl , Nd2 ) -AdmtO  Ineighbor  interact 
ELSE  lelse  Meth=2,  hopper /sparseness  tech 

LET  Hrel=Nd2-Ndl  lNd2's  address  relv  to  diag  element 
IF  Ndl<=Hedge  THEN  Ifill  hopper 

LET  Act2 ( Hdig ) =Act2 (Hdig ) +Admt0  INdl  self  interact 


lelse,  Face=0  (lower  face) 


THEN  Nd2=Ndl-l 

AND  Kond=2  THEN  Nd2=Ndl+Xmax-l  Iwrap  periodic  X 
THEN  Nd2=Ndl-Xmax 

AND  Kond=2  THEN  Nd2=Ndl+Zxy-Xmax  Iwrap  periodic  Y 
THEN  Nd2=Ndl-Zxy 

THEN  Nd2=0  Iground  electrode  is  neighbor 


85 


7080  IF  Hrel<0  THEN  lie  Nd2<Ndl ,  neighbor  interact 

7090  LET  Act 2 ( Hdig+Hrel ) =Act2 (Hdig+Hrel ) -AdmtO 

7100  END  IF 

7110  ELSE  lelse  w/  hopper/sparseneas  analysis 

7120  LET  Act2 ( Hmem) =Act2 (Hmem) +AdmtO 

7130  IF  Hrel<0  AND  Hrel+Hedge>0  THEN  Igood  neighbors,  go  ahead 

7140  LET  Act2 (Hmem+Hrel)=Act2 (Hmem+Hrel ) -AdmtO 

7150  END  IF 

7160  END  IF  !  end  if  Ndl>Hedge 

7170  END  IF  IMeth 

7180  END  IF  lOn  Admittances  non-zero 

7190  END  IF  lend  if,  Nd2  is  decent  neihbor 

7200  IF  Meth=2  AND  Nd2=Ndmax  THEN  lif  path  to  exciter  electrode 

7210  LET  Act 2 ( Hmem) =Act2 (Hmem) +Dlct ( Pixl ( Ndl ) ) * Zadm 

7220  END  IF 

7230  NEXT  Face 

7240  NEXT  Axs 

7250  IF  Dtl  THEN  PRINT 

7260  IF  Dtl  AND  Meth=2  THEN 

7270  PRINT  USING  Feed  ["", DD, Ndl 

7280  IF  Ndl<=Hedge  THEN  Hlmt=Hdig-Ndl+l 

7290  IF  Ndl>Hedge  THEN  Hlmt=Hmem-Hedge+l 

7300  FOR  Hclm=Hlmt  TO  Hdig 

7310  PRINT  USING  ("",  4A,  #*';  VAL$  < REAL  (Act2  ( Helm)  )  ) 

7320  PRINT  USING  , " " , 4A, ” ” ; VAL$ ( I MAG (Act 2 (Helm) ) ) 

7330  IF  He lm-Hlmt  MOD  6=5  THEN  PRINT  Istart  a  new  line 

7340  NEXT  Helm 

7350  IF  Hclm-Hlmt  MOD  6<>0  THEN  PRINT 

7360  END  IF  lend  if,  Dtl 

7370  IF  Meth=2  AND  Ndl>=Hedge  THEN  Istart  hopper  reduction 

7380  LET  Lpiv=Lpiv+l  1#  pivoting  occurances 

7390  MAT  Hpiv= ( CMPLX (0,0) ) 

7400  LET  Hpiv ( 1 ) =CMPLX (1,0) 

7410  IF  Act2 ( 1 ) OCMPLX (0,0)  THEN  1  initialize  pivoting  vector 

7420  LET  Hnrm=l/Act2 ( 1 )  Inormalizing  factor 

7430  LET  Hclm=2  [relative  address  counter 

7440  IF  Dtl  THEN  PRINT  "  Piv  { " ; VAL$ ( Lpiv) ; " >  (1,0)"; 

7450  FOR  Hrow=2  TO  Hedge  1  set  pivot  vector 

7460  LET  Hpiv(Hrow) =Act2 (Helm) *Hnrm 

7470  IF  Back  THEN  Tca2 ( Hrow-1 , Lpiv ) =Hpiv ( Hrow ) 

7480  IF  Dtl  THEN  Iprint  out  pivots 

7490  PRINT  USING  4A ,0"; VAL$ ( REAL ( Hpiv ( Hrow) ) ) 

7500  PRINT  USING  , 4A , VAL$ ( IMAG ( Hpiv ( Hrow) ) ) 

7510  END  IF 

7520  LET  Hclm=Hc lm+Hrow  12,4.7,11,16..  row  start 

7530  NEXT  Hrow 

7540  IF  Dtl  THEN  PRINT 

7550  END  IF  lend  if,  pivot  setting 

7560  LET  Hcnt=l  lend  of  row  counter 

7570  FOR  Hrow=2  TO  Hedge  1  heart  of  pivoting 

7580  IF  Hpiv ( Hrow' OCMPLX (0,0)  THEN  1  go  ahead 

7590  FOR  Hclm=2  TO  Hrow  ladj  @  row  with  pivots 

7600  LET  Nmr=Hcnt+Hclm 

7610  LET  Act2 (Nmr ) =Act2 (Nmr ) -Act2 (Hcnt+1 ) *Hpiv (Helm) 

7620  NEXT  Helm 
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7630  END  IF 

7640  LET  Hcnt=Hcnt+Hrow  11,3,6,10..  gives  row  ends 

7650  NEXT  Hrow 

/ 660  IF  Dtl  THEN 

7670  LET  Hcnt=0 

7680  FOR  Nmr=l  TO  Hedge  l dump  Act2  array 

7690  PRINT  USING  .  Hop  act< DD -Nmr 

7700  FOR  Hclm=l  TO  Nmr 

7710  PRINT  USING  "  "  (  ”  "  ,  4A,  ;  VAL$  ( REAL  ( Act2  ( Hclm+Hcnt )  )  ) 

7720  PRINT  USING  4A, " ;VAL$ ( IMAG (Act2 ( Hclm+Hcnt )) ) 

7730  IF  Helm  MOD  6=0  THEN  PRINT  1  start  a  new  line 

7740  NEXT  Helm 

7750  IF  Helm  MOD  6<>1  THEN  PRINT 

7760  LET  Hcnt=Hcnt+Nmr  10,1,3,6,10,15..  diags 

7770  NEXT  Nmr 

7780  END  IF  lend  if  Dtl,  Act  array  dump 

7790  LET  Hcnt=0  lref  address  to  end  of  previous  row 

7800  FOR  Hrow=l  TO  Hedge-1  1  shakedown  for  hopper 

7810  FOR  Hclm=l  TO  Hrow 

7820  LET  Nmr=Hcnt+Hclm 

7830  LET  Act2 (Nmr ) =Act2 (Nmr+l+Hrow) 

7340  NEXT  Helm 

7850  LET  Hcnt=Hcnt+Hrow  10,1,3,6,10,15..  row  ends 

7860  NEXT  Hrow  1  ready  to  feed  hooper 

7870  FOR  He lm=Hmem+l -Hedge  TO  Hmem 

7880  LET  Act 2 ( Helm) =CMPLX (0,0)  1  zero  to  feed  new  elements 

7890  NEXT  Helm 

7900  END  IF  lend  if  for  Ndl>Hedge 

7910  IF  NdKHedge  THEN  Hdig=Hdig+Ndl+l  11,3,6,10..  row  end 

7920  NEXT  Ndl 

7930  LET  Ndl=Ndmax  [Exciter  node 

7940  IF  Dtl  THEN  PRINT  USING  . Node  [ " " , DD , " ” )  touches" Ndl 

7950  IF  Back  THEN  MAT  Endex= (CMPLX ( 0 , 0 ) )  Unitialize  exciter  interact 
7960  FOR  Nd2=Ndmax-Zxy  TO  Ndmax-1  !Z=Zmax  level  nodes  to  exciter 
7970  IF  Dtl  THEN  PRINT  USING  ("", DD ;Nd2 

7980  LET  Admt0=Dlct(Pixl(Nd2) )*Zadm!path  admittance  to  exciter 

7990  LET  Hrel=Nd2-Ndl  1  relative  hopper  address 

8000  IF  Meth=l  THEN 

8010  LET  Act  1 ( Ndl , Ndl ) =Actl ( Ndl , Ndl ) +Admt0 

8020  LET  Act  1 ( Nd2 , Nd2 ) =Act 1 (Nd2 , Nd2 ) +Admt0 

8030  LET  Act  1 ( Ndl , Nd2 ) =Act 1 ( Ndl , Nd2 ) -AdmtO 

8040  LET  Act  1 ( Nd2 , Ndl ) =Actl ( Nd2 , Ndl ) -AdmtO 

8050  ELSE 

8060  LET  Act2 (Hmem) =Act2 (Hmem) +Admt0 

8070  IF  Hrel+Hedge>0  THEN  Igood  neighbor  to  interact 

8080  LET  Act2 (Hmem+Hrel ) =Act2 (Hmem+Hrel )-Admt0 

8090  END  IF 

8100  END  IF  lend  if  Meth 

8110  IF  Back  THEN  1  save  exciter  interactions 

8120  LET  Endex ( Zxy+1 ) =Endex ( Zxy+1 ) +Admt0  iself  exciter 

8130  LET  Endex ( Zxy+l+Hrel ) =Endex ( Zxy+ 1+Hrel ) -AdmtO  Ineighbor  to  exciter 

8140  END  IF 

8150  NEXT  Nd2 

8160  IF  Dtl  THEN  PRINT 

8170  IF  Dtl  AND  Meth=2  THEN 
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8180  PRINT  USING  Feed  [ " " , DD , " Ndl 

8190  LET  Hlmt=Hmem-Hedge+l 

8200  FOR  Hclm=Hlmt  TO  Hdig 

8210  PRINT  USING  . 4A, #” ;VAL$ (REAL ( Act2 (Helm) ) ) 

8220  PRINT  USING  ,  "  " , 4A, " VAL$ { I MAG ( Act 2 ( Helm) ) ) 

8230  IF  Hclm-Hlmt  MOD  6=5  THEN  PRINT  1  start  a  new  line 

8240  NEXT  Helm 

8250  IF  Hclm-Hlmt  MOD  6<>0  THEN  PRINT 

8260  END  IF  1  end  if  Dtl 

8270  IF  Meth=l  THEN 

8280  LET  TmvO=TIMEDATE  lClock  nodal  analysis,  Meth=l 

8290  DISP  "  . .wait, ”;Rptr;”of  " ;VAL$ ( SHIFT ( Rep, - (Knj>0 )) +Rman ) ; 

8300  DISP  ”,  solve” ; Ndmax ; "nodes  from  ”;TIME$ (TmvO) 

8310  MAT  Tcal=INV{ Actl )  [solving  nodal  analysis  matrix 

8320  ELSE 

8330  FOR  Hlmt=Hedge  TO  2  STEP  -1  Iplay  out  hopper  to  funnel  it  down 

8340  LET  Lpiv=Lpiv+l  1#  of  pivoting  occurances 

8350  MAT  Hpi v= ( CMPLX (0,0) ) 

8360  LET  Hpi v ( 1 ) =CMPLX (1,0) 

8370  IF  Act2 ( 1 ) OCMPLX ( 0 , 0 )  THEN  linitialize  pivoting  vector 

8380  LET  Hnrm=l/Act2 ( 1 )  [normalizing  factor 

8390  IF  Dtl  THEN  PRINT  ”  Piv  { ” ;VAL$ (Lpiv) ; ” >  (1,0)”; 

8400  LET  Hclm=2  1  relative  address  counter 

8410  FOR  Hrow=2  TO  Hlmt  1  set  pivot  vector 

8420  LET  Hpiv(Hrow)=Act2(Hclm)*Hnrm 

8430  IF  Back  THEN  Tca2 ( Hrow-1 , Lpiv ) =Hpiv ( Hrow ) 

8440  IF  Dtl  THEN  [print  out  pivots 

8450  PRINT  USING  (" ” , 4A, #” ; VAL$ (REAL(Hpiv (Hrow) ) ) 

8460  PRINT  USING  4A, ;VAL$ ( IMAG ( Hpiv ( Hrow) ) ) 

8470  END  IF 

8480  LET  Hclm=Hclm+Hrow  [2,4,7,11,16..  row  starts 

8490  NEXT  Hrow 

8500  IF  Dtl  THEN  PRINT 

8510  END  IF  lend  if,  pivot  setting 

8520  LET  Hcnt=l  lend  of  row  counter 

8530  FOR  Hrow=2  TO  Hlmt  [heart  of  pivoting 

8540  IF  Hpiv (Hrow) OCMPLX (0,0)  THEN  lyo  ahead 

8550  FOR  Hclm=2  TO  Hrow  ladj  @  row  with  pivots 

8560  LET  Nmr=Hcnt+Hclm 

8570  LET  Act2 (Nmr ) =Act2 (Nmr ) -Act2 (Hcnt+1 ) *Hpiv (Helm) 

8580  NEXT  Helm 

8590  END  IF 

8600  LET  Hcnt=Hcnt+Hrow  [1,3,6,10,15..  row  ends 

8610  NEXT  Hrow 

8620  IF  Dtl  THEN 

8630  LET  Hcnt=0 

8640  FOR  Nmr=l  TO  Hlmt  [dump  Act2  array 

8650  PRINT  USING  ”””  Hop  act< DD, Nmr 

8660  FOR  Hclm=l  TO  Nmr 

8670  PRINT  USING  . ( " " , 4A, #" ; VAL$ ( REAL (Act 2 ( Hclm+Hcnt ) ) ) 

8680  PRINT  USING  4A, "”)””,#”; VAL$ ( IMAG < Act2 ( Hclm+Hcnt )) ) 

8690  IF  Helm  MOD  6=0  THEN  PRINT  l start  a  new  line 

8700  NEXT  Helm 

8710  IF  Helm  MOD  6<>1  THEN  PRINT 

8720  LET  Hcnt=Hcnt+Nmr  10,1,3,6,10,15..  diags 
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8730 

NEXT  Nmr 

8740 

END  IF 

lend  if  Dtl,  Act  array  dump 

8750 

LET  Hcnt=0 

Iref  address  to  end  of  previous 

row 

3760 

FOR  Hrow=l  TO  Hlmt-1 

1  shakedown  for  hopper 

8770 

FOR  Hclm=l  TO  Hrow 

8780 

LET  Nmr=Hcnt+Hclm 

8790 

LET  Act2 (Nmr ) =Act2 ( Nmr+l+Hrow) 

8800 

NEXT  Helm 

8810 

LET  Hcnt=Hcnt+Hrow 

10,1,3,6,10,15..  row  ends 

8820 

NEXT  Hrow 

8830 

FOR  Hclm=Hcnt+l  TO  Hcnt+Hlmt 

8840 

LET  Act2 (Helm) =CMPLX(0, 0) 1  zero  last  Hopper  row 

8850 

NEXT  Helm 

8860 

NEXT  Hlmt 

8870 

END  IF 

lend  if  Meth  choices 

8880 

LET  Tmvl=TIMEDATE 

8890 

DISP  ">" ;TIME$ (Tmvl-TmvO) 

8900 

IF  Dtl  THEN 

8910 

PRINT  "Nodal  analysis  solution  required  elapsed  time  of  ” ; 

8920 

PRINT  TIME$ (Tmvl-TmvO) " 

8930 

END  IF 

8940 

IF  Dtl  AND  Meth=l  THEN 

1  Printout  of  nodal  analysis  array 

8950 

PRINT  "Contents  of  classic  nodal  analysis  array" ;Ndmax; "x  "; 

8960 

PRINT  VAL$ (Ndmax) ; " ,  starting  at  node  (1,1).." 

8970 

FOR  Ndl=l  TO  Ndmax 

8980 

LET  Admt  2  =CMPLX (0,0) 

1  initialize  nodal  row  accumulation 

8990 

PRINT  USING  . [ " " , DD , " " , * 

)"",#"; Ndl 

9000 

FOR  Nd2=l  TO  Ndmax 

9010 

LET  Admt2=Admt2+Actl (Ndl 

,Nd2) 

9020 

PRINT  USING  ( " " , 4A, #" 

;  VAL$ (REAL (Act 1 (Ndl ,  Nd2 ) ) ) 

9030 

PRINT  USING  . , " " , 4A, " " 

)  " " , #" ; VAL$ ( I MAG (Act 1 ( Ndl , Nd2 ) ) ) 

9040 

IF  Nd2  MOD  6=0  THEN  PRINT  1  start  a  new  line 

9050 

NEXT  Nd2 

9060 

PRINT  USING  . . @ , 5A, ; 

VAL$ ( REAL ( Admt 2 ) ) 

9070 

PRINT  USING  . , " " , 5A, " " ) " 

"  " ; VAL$ ( IMAG ( Admt2 ) ) 

9080 

NEXT  Ndl 

9090 

END  IF 

lend  if  Dtl  &  Meth=l 

9100 

IF  Dtl  AND  Meth=2  THEN 

9  i  10 

PRINT  USING  """  FinalHopAct<"",DD, "">"", #";Nmr 

9120 

PRINT  USING  ""”(”", 5A, #" ; VAL$ ( REAL ( Act 2 ( 1 ) ) ) 

9130 

PRINT  USING  5A, "") """ 

;VAL$ ( IMAG (Act2 ( 1 ) ) ) 

9140 

END  IF 

1  end  if  Dtl 

9150 

LET  Hnrm=CMPLX( 1,0) 

!  anticipated  normed  current 

9160 

IF  Meth=l  THEN 

9170 

MAT  Ptn=Tcal  (  *  ,  "Idmax ) 

Ipotentials,  exciter  at 

(i»* 

9180 

IF  Back  THEN 

1  check  on  exciter 

9190 

LET  Hnrm=CMPLX (0,0) 

Inode  current 

9200 

FOR  Ndl=0  TO  Zxy 

9210 

LET  Hnrm=Hnrm+Ptn(Ndmax- 

Ndl ) *Endex ( Zxy+l-Ndl ) 

9220 

NEXT  Ndl 

9230 

END  IF 

9240 

LET  Resp=Tcal (Ndmax, Ndmax) 

IResultant  permittivity 

925G 

IF  Resp<>CMPLX (0,0)  THEN  LET 

Resp=2*Norm/Resp 

9260 

ELSE 

lelse  do  Meth=2 

9270 

IF  Back  THEN 
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9280 
9290 
9300 
9310 
9320 
9330 
9340 
9350 
9360 
S  J70 
9380 
9390 
9400 
9410 
9420 
9430 
9440 
9450 
9460 
9470 
9480 
9490 
9500 
9510 
9520 
9530 
9540 
9550 
9560 
9570 
9580 
9590 
9600 
9610 
9620 
9630 
9640 
9650 
9660 
9670 
9680 
9690 
9700 
9710 
9720 
9730 
9740 
9750 
9760 
9770 
9780 
9790 
9800 
9810 
9820 


MAT  Ptn= ( CMPLX (0,0) ) 

IF  Act2 ( 1 ) OCMPLX (0,0)  THEN  LET  Ptn ( Ndmax ) =1 /Act2 ( 1 ) 

FOR  Ndl=Lpiv  TO  1  STEP  -1  Ibacktrack  node  potentials 

LET  Hlmt=MIN (Hedge-1 , Ndmax-Ndl ) 

FOR  Hclm=l  TO  Hlmt 

LET  Nmr=Ndl+Hclm  !Tca2  node  number 

LET  Ptn{Ndl ) =Ptn(Ndl ) -Tca2 (Helm, Ndl ) *Ptn (Nmr ) 

NEXT  Helm 
NEXT  Ndl 

LET  Hnrm=CMPLX(0,0)  inode  current 

FOR  Ndl=0  TO  Zxy 

LET  Hnrm=Hnrm+Ptn (Ndmax-Ndl ) *Endex (Hedge-Ndl ) 

NEXT  Ndl 
END  IF 

LET  Rusp=2 *Norm*Act2 ( 1 ) 

END  IF 

IF  Back  THEN  Resp=Resp*Hnrm 
IF  Back  OR  Meth=l  THEN 
MAT  Fluz= ( CMPLX ( 0 , 0 ) ) 

FOR  Ndl=l  TO  Ndmax- 1 

LET  Admtl=Dlct ( Pixl (Ndl ) ) 

LET  Nd2=Ndl-7.xy 
IF  Nd2<l  THEN 

LET  Fluz ( Ndl ) = . 5*Admt l*Ptn ( Ndl ) 

ELSE 

LET  Admt2=Dlct (Pixl(Nd2) ) 

LET  Admt0=Admtl+Admt2 
IF  AdmtOoCMPLX (0,0)  THEN 
LET  Admt0=Admtl*Admt2/Admt0 
LET  Admt0= ( Ptn ( Ndl ) -Ptn ( Nd2 ) ) *Admt0 
LET  Fluz(Ndl)=. 5*Admt0 
END  IF 

END  IF  lend  if,  Nd2<l 

LET  Nd2=Ndl+Zxy  ! upper  node  neighbor 

IF  Nd2>=Ndmax  THEN  ! admittance  to  exciter 

LET  Fluz ( Ndl ) =Fluz (Ndl )+ . 5*Admtl* ( Ptn ( Ndmax ) -Ptn (Ndl ) ) 

ELSE 

LET  Admt2=Dlct (Pixl (Nd2 ) )  ineighbor  admittance 

LET  Admt0=Admtl+Admt2 
IF  AdmtOoCMPLX  (0,0)  THEN 
LET  AdmtO=Admtl*Admt2/Admt0 
LET  Admt0= ( Ptn ( Nd2 ) -Ptn ( Ndl ) ) * AdmtO 
LET  Fluz ( Ndl ) =Fluz ( Ndl )+. 5*Admt0 
END  IF 

END  IF  lend  if,  Nd2>=Ndmax 

NEXT  Ndl 

END  IF  lend  if,  Back  or  Meth=l 

IF  Rman  AND  (Meth=l  OR  Back)  THEN 

IF  REAL (Ptn (Ndmax) )<>0  THEN  MAT  Ptn=Ptn/ ( REAL ( Ptn ( Ndmax )) ) 
PRINT  "Potentials:  at  exciter  node 

PRINT  USING  . ( " " , 5A, #" ; VAL$ ( REAL ( Ptn ( Ndmax ) ) ) 

PRINT  USING  , " " , 5A , " " ) ; VAL$ ( IMAG ( Ptn ( Ndmax )) ) 

FOR  Xcnt=l  TO  Xmax 

PRINT  "  Cross  section,  X=" ; VAL$ ( Xcnt ) 

FOR  Zcr.t  =  Zmax  TO  1  STEP  -1 


lend  if,  back 
IResultant  permittivity 
lend  if  Meth 

Ibacksubstition  correction 
Ipresumably  arrays  exist 
Ifor  displacement  flux  lines 

1  lower  node  neighbor 
1  admittance  to  ground 
Ineighbor  admittance 
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9830 
9840 
9850 
9860 
9870 
9880 
9890 
9900 
9910 
9920 
9930 
9940 
9950 
9960 
9970 
9980 
9990 
10000 
10010 
10020 
10030 
10040 
10050 
10060 
10070 
10080 
10090 
10100 
10110 
10120 
10130 
10140 
10150 
10160 
10170 
10180 
10190 
10200 
10210 
10220 
10230 
10240 
10250 
102  60 
102  70 
10280 
102  90 

10300 

10310 

10320 

10330 

10340 

10350 

10360 

10370 


FOR  Ycnt=l  TO  Ymax 

LET  Nwrk=FNOde_mk(Xcnt , Ycnt , Zcnt , Xmax , Ymax , Zmax ) 

PRINT  USING  """("", 5A, ; VAL$ ( REAL ( Ptn (Nwrk) ) ) 

PRINT  USING  "’’,5a,  #" ;VAL$ ( IMAG ( Ptn (Nwrk) ) ) 

IF  Ycnt  MOD  5=0  THEN  PRINT 
NEXT  Ycnt 

IF  Ycnt  MOD  5<>1  THEN  PRINT 
NEXT  Zcnt 
NEXT  Xcnt 

PRINT  "Displacement  fluxes:  exciter  node  normalized  to  (1,0)" 

LET  Admt2=CMPLX(0,0) 

FOR  Xcnt=l  TO  Xmax 

PRINT  "  Cross  section,  X=n ;VAL$ (Xcnt ) 

FOR  Zcnt=Zmax  TO  1  STEP  -1 
FOR  Ycnt=l  TO  Ymax 

LET  Nwrk=FNOde_mk( Xcnt, Ycnt, Zcnt, Xmax, Ymax, Zmax) 

1  PRINT  USING  5A, VAL$ (REAL < Fluz (Nwrk ) ) ) 

1  PRINT  USING  """, "" ,5A, " ” ) " " , ; VAL$ ( IMAG{ Fluz (Nwrk) ) ) 

LET  Nmr=INT ( . 5+4*Zxy*REAL(Fluz (Nwrk) ) ) 

LET  Nd2=7-SHIFT(Nmr+l , 1 ) 

IF  Nd2>0  THEN  Nmr=Nmr+Nd2  ! roughly  centered 
FOR  Ndl=l  TO  13  Iprint  real  flux 

IF  Ndl<Nd2  THEN  PRINT  " 

IF  Ndl>=Nd2  AND  NdKNmr  THEN  PRINT  ••"••••; 

IF  Ndl>Nmr  THEN  PRINT  "  "  ; 

NEXT  Ndl 

IF  Ycnt  MOD  5=0  THEN  PRINT 
LET  Admt2=Admt2+Fluz (Nwrk) 

NEXT  Ycnt 

IF  Ycnt  MOD  501  THEN  PRINT 
NEXT  Zcnt 
NEXT  Xcnt 

LET  Admt2=Admt2 /Zmax 

PRINT  "Average  displacement  flux  through  a  plane"; 

PRINT  "  perpendicular  to  the  electrodes  is  " 

PRINT  "  ( " ;VAL$ ( DROUND ( REAL ( Admt2) ,4) ) ; 

PRINT  ", " ; VAL$ ( DROUND ( IMAG ( Admt2 ) , 4 ) ) ; ” ) ” 

END  IF  !  end  if  for  Rman  output 

PRINT  "  Resultant  permittivity  is  ( " ;REAL ( Resp) ; ” , " ; IMAG(Resp) ; " )  &  it's" 
LET  Alph=FNWnr (Diet ( * ) , Frk( * ) ,Resp, Iterr , Spcs) 

IF  IMAG  ( Alph )  oRelay  (  7  )  THEN 
IF  REAL  (Alph )  ORelay  (  6 )  THEN 

PRINT  "  fail?  to  pass  both  cmplx  parts  of  exp  av"; 

ELSE 

PRINT  "  fail?  to  pass  imag  part  of  the  exp  ave"; 

END  IF 

PRINT  "  factr  via  FNWnr,  now  using  Relay(6&7)" 

LET  A 1 ph=CMPLX ( Re 1 ay ( 6 ) ,Relay(7) ) 

END  IF 

PRINT  "  exponential  averaging  (also  Wiener  or  scries<->parallel ) " ; 

PRINT  "  factor  is" 

PRINT  "  ( " ; REAL (Alph );","; IMAG (Alph );").” 

IF  Ndmax>l  THEN  PRINT  "  Inter faces/pixel= ” ;VAL$ ( DROUND ( Inf c/ ( Ndmax-1 ), 4 )) ; 
IF  Back  THEN  PRINT  "  &  backsubst  correct ion=" ; VAL$ ( ABS (Hnrm-CMPLX (1,0))) 
REM  Output  each  cycle  to  internal  storage  array 
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10380 

10390 

10400 

10410 

10420 

10430 

10440 

10450 

10460 

10470 

10480 

10490 

10500 

10510 

10520 

10530 

10540 

10550 

10560 

10570 

10580 

10590 

10600 

10610 

10620 

10630 

10640 

10650 

10660 

10670 

10680 

10690 

10700 

10710 

10720 

10730 

10740 

10750 

10760 

10770 

10780 

10790 

10800 

10810 

10820 

10830 

10840 

10850 

10860 

10870 

10880 

10890 

10900 

10910 

10920 


IF  Knj=2  THEN  !  averaged  cases  of  conjugation  pairs 

LET  Nwrk=SHIFT(Rptr+l,  1)  1  effective  1 , 1 , 2 , 2 , 3 , 3  .  . 

LET  Graf (Nwrk, 1 ) =(Nwrk+Iterr ) * . 5+Graf (Nwrk, 1 ) 

LET  Graf ( Nwrk , 2 ) =Frk ( 1 ) * . 5+Graf ( Nwrk, 2 ) 

LET  Gra f ( Nwrk , 3 ) =REAL ( Alph ) * . 5  +Gra f ( Nwrk , 3 ) 

LET  Graf {Nwrk, 4) =IMAG( Alph)* . 5+Graf (Nwrk, 4) 

LET  Graf (Nwrk, 5) =REAL(Resp) *. 5+Graf {Nwrk, 5) 

LET  Graf ( Nwrk, 6 ) =IMAG { Resp) * . 5+Graf ( Nwrk, 6 ) 

IF  Ndmax>l  THEN  LET  Graf (Nwrk, 7 ) =Infc/ (Ndmax-1 ) 

IF  Ptrn=5  THEN  1  other  information  programmed 

LET  Graf ( Nwrk, 8 ) =Relay ( 4 ) * . 5+Graf (Nwrk, 8 )  lellipse  roles 
ELSE 

LET  Graf (Nwrk, 8)=Relay (2 ) * . 5+Graf (Nwrk, 8 ) 

END  IF 

ELSE  1  consequetive  cases,  no  averaging 

LET  Graf (Rptr , 1 ) =Rptr+Iterr 
LET  Graf (Rptr, 2 ) =Frk( 1 ) 

LET  Graf (Rptr, 3) =REAL( Alph) 

LET  Graf (Rptr, 4)=IMAG(Alph) 

LET  Graf ( Rptr , 5 ) =REAL (Resp) 

LET  Graf (Rptr, 6 ) =IMAG(Resp) 

IF  Ndmax>l  THEN  LET  Graf ( Rptr , 7 ) =Sg j *  Inf c/ ( Ndmax- 1 ) 

IF  Ptrn=5  THEN  !  other  programmed  information 

LET  Graf ( Rptr , 8 ) =Relay ( 4 )  !  ellipse  role 
ELSE 

•LET  Graf ( Rptr, 8 ) =Relay ( 2 )  1  shuffle  choice 
LET  Graf (Rptr,8)=Tmvl-TmvO  1  matrix  inversion  time 
END  IF 

END  IF  1  end  if,  Knj=2 

IF  Rep>0  THEN  SOUND  1,100, 10,. 04  1  low  audible  tone  per  Rptr  cycle 
LET  Tmup=Tmcyc+ ( TIMEDATE-Tmcyc ) * ( SHIFT ( Rep, - ( Kn j >0 ) ) +Rman) /Rptr +4 
IF  Knj>0  THEN  ! conjugate  on  altn  Rptr  after  data  done 

MAT  Dlct=CONJG (Diet ) 

LET  Sgj=-Sg j 
END  IF 

DISP  "  finis  ' "  , -TIME$ (Tmup) ; " 

DISP  USING  "AAAAAA, #" ; DATES (Tmup) 

NEXT  Rptr 

IF  Sgj=-1  THEN  ! hopefully  unCONJGates 

MAT  Dlct=CONJG ( Diet ) 

LET  Sg j  =  1 
END  IF 


SUMMARY 


OUTPUT 


DISP 

LET  Bhdr$="PIXonNODE  " 

LET  Bhdr$=Bhdr$&"SI Z= ( "&VAL$ ( Xmax ) &"x"&VAL$ ( Ymax ) &"x"&VAL$ ( Zmax ) &” ) 
LET  Bhdr$=Bhdr$&"SCL="&VAL$ ( DROUND (Xscl, 3) ) &" , " 

LET  Bhdr$=Bhdr$&VAL$  ( DROUND  { Yscl ,  3  )  )&", "&VAL$ (DROUND ( Zscl , 3 )  )&•’  ” 

IF  Kond=l  THEN  Bhdr$=Bhdr$&”InslBC  ” 

IF  Kond=2  THEN  Bhdr$=Bhdr$&nPrdcBC  " 

IF  Meth=l  THEN  Bhdr$=Bhdr$&"Trad  ” 

IF  Meth=2  THEN  Bhdr$=Bhdr$S"Spar  " 

IF  Ptrn=0  THEN  Bhdr$=Bhdr$&" f rom  prev  " 

IF  Ptrn=l  THEN  Bhdr$=Bhdr$&" f rom  &Fln$6 . 

IF  Ptrn=2  THEN  Bhdr$=Bhdr $&" f rom  USER  " 
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10*»30 
10940 
10950 
10960 
10970 
10980 
10990 
11000 
11010 
11020 
11030 
11040 
110S0 
11060 
11070 
11080 
11090 
11100 
11110 
11120 
11130 
11140 
11150 
11160 
11170 
11180 
11190 
11200 
11210 
11220 
11230 
11240 
11250 
11260 
11270 
11280 
1  1290 
11300 
11310 

I  1320 
11330 
11310 
11350 

I I  360 
11370 
11380 
11390 
11400 
11410 
11420 
11430 
1  1440 
11450 
11460 
11470 


IF  Ptrn=3  THEN  Bhdr  $=Bhdr$S<  "RANDOM  " 

IF  Ptrn=4  THEN  Bhdr$=Bhdr$£"FRACTAL  " 

IF  Ptrn=5  THEN  Bhdr$=Bhdr$&"ELLIPS  " 

IF  Kn j  =0  THEN  Bhdr $=Bhdr$6"NO  *  “ 

IF  Kn j=l  THEN  Bhdr$=Bhdr$&"ALT*  " 

IF  Kn j=2  THEN  Bhdr$=Bhdr$&"AVG*  " 

IF  LEN ( Bhdr $ ) <80  THEN  Bhdr$ [ 1+LEN ( Bhdr$ ) ]=RPT$ ( "  " , 80-LEN ( Bhdr$ ) ) 

LET  Trs$=TIME$ (TIMEDATE ) 

LET  Ws$=DATE$( TIMEDATE )&"  "&Trs$(l;5] 

LET  Bhdr$ ( 81-LEN( Ws$ ) ]=Ws$  !  Tack  time  &  date  to  end 

IF  Rep>l  THEN 

PRINT  "Summary  of  repeat  cycles:  (may  be  reprogrammed)” 

PRINT  ”  TRY. err,  VOL  FRACTs,  REAL,  IMAG  ALPHA,"; 

PRINT  M  REAL,  IMAG  PERMITTIVITY,  &  more" 

FOR  Rptr=l  TO  SHIFT(Rep,-(Knj=l) ) 

PRINT  "#"  ; VAL$ ( Rptr ) 

FOR  Xcnt=l  TO  Kwd 

PRINT  USING  "X, 10A,#”;VAL$(DROUND(Graf (Rptr,Xcnt) ,4) ) 

NEXT  Xcnt 
PRINT 
NEXT  Rptr 
IF  Svr  THEN 

LET  Nmr=SIZE (Graf , l)*SIZE(Graf,2)  lmemory  elements  (@8  bytes) 

IF  Ovr=3  THEN  CREATE  Fln$ , Nmr*8 . 0+256 . 0  ! for  HFS 
1  I F  Ovr  =  3  THEN  CREATE  Fln$,l  Ifor  LIF  or  DOS 

LET  Nmr=SHI FT ( Rep, - ( Kn j=l ) )  llength  of  array  Graf 

REDIM  Graf ( 1 :Nmr , 1 :Kwd)  1  REDIM  necessary  to  size  COM  output 

ASSIGN  @Savgraf  TO  Fln$ ; FORMAT  OFF 
IF  Ovr=l  OR  Ovr=3  THEN 

OUTPUT  @Savgraf ; Ahdr $ , Bhdr $ , Nmr , Kwd , Graf ( * ) 

OUTPUT  @Savgraf ;Dlct ( * ) , Xmax, Ymax, Zmax, Xscl, Yscl , Zscl , END 
END  IF 

IF  Ovr=2  THEN  !  append  only 

ON  END  @Savgraf  GOTO  11300 
REM  read  until  end 

ENTER  @Savgraf ;Nwrk  1  read  by  integers  ( ie  2  bytes) 

GOTO  11270 

REM  at  file  end  now  append 
OFF  END  @Savgraf 

OUTPUT  @Savgraf ;Ahdr$, Bhdr$ , Nmr , Kwd, Graf (*  ) 

OUTPUT  @Savgraf ;Dlct ( * ) , Xmax, Ymax, Zmax, Xscl, Yscl , Zscl , END 
END  IF  1  end  if  to  append 

ASSIGN  @Savgraf  TO  * 

END  IF 
END  IF 

LET  Chdr$=Ahdr$  ! save  titling 

LET  Dhdr$=Bhdr$ 

LET  Meml=INT ( . 5+VAL ( SYSTEMS ( "AVAILABLE  MEMORY"))) 

PRINT  "New  memory  used  is" ; PROUND ( (MemO-Meml ) /16, 2 ) ; "&  memory"; 

PRINT  "  remaining  is" ; PRoUND (Meml/ 16 , 2 ) ; " in  complex  units." 

LET  Tml=TIMEDATE 

PRINT  "TOTAL  ELAPSED  TIME:  "; TIMES ( Tml-TmO ) 

PRINT  "Date:  " ; DATES (Tml ) ; RPT$ ( "  _  " , 7 ) ; "FINIS" ; 

PRINT  RPT$ ( "  _  " , 7 ) ; " T ime :  ", -TIMES (Tml ) 

SOUND  1,132, 14,. 2  !  last  call,  tell  user  done 
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11480 
11490 
11500 
11510 
11520 
11530 
1  j.540 
11550 
11560 
11570 
11580 
11590 
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11630 
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11650 
11660 
11670 
11680 
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11720 
11730 
11740 
11750 
11760 
11770 
11780 
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11800 
11810 
11820 
11830 
11840 
11850 
11860 
11870 
11880 
11890 
11900 
11910 
11920 
11930 
11940 
11950 
11960 
11970 
11980 
11990 
12000 
12010 
12020 


WAIT  .25 

SOUND  1,110,15, .5 

DISP  "Last  nodal  analysis  solution  cycle  required  elapsed  time  of  " ; 

DISP  TIME$ (Tmvl-TmvO ) ; ” . " 

END 

1  (  ]  [  1  [  FNOdejnk  ][]()(] 

DEF  FNOde_mk{ INTEGER  Xmk, Ymk, Zmk, Xbi g, Ybig, Zbig ) 

I  This  function  returns  the  node  number  for  the  box  Pixel  grid 
1  Xmk, Ymk, Zmk  *  the  address  coordinates  of  the  pixel 
!  Xbig, Ybig, Zbig  =  the  Pixel  extent  in  each  direction 
INTEGER  Ndmk 1  Node  number 

IF  Zmk>0  AND  Zmk<=Zbig  THEN  Ndmk=Xmk+ ( ( Ymk-1 ) + ( Zmk-1 ) *Ybig ) *Xbig 
IF  Zmk<0  THEN  Ndmk=0  lGround  electrode 

IF  Zmk>Zbig  THEN  Ndmk=Xbig*Ybig*Zbig+l  1  Exciter  electrode 
IF  Xmk<l  OR  Xmk>Xbig  OR  Ymk<l  OR  Ymk>Ybig  THEN  Ndmk=-1 
RETURN  Ndmk 
FNEND 

1  [  ]  [  )  [  SUB  Nodeaddrs  [][][] 

SUB  Nodeaddrs ( INTEGER  Ndsrc,Xxx,Yyy, Zzz,Xlmt, Ylmt, Zlmt) 

!  This  subroutine  returns  the  (X,Y,Z)  addresses  for  a  node  number 
1  Ndsrc  =  the  node  number  IN  variable 

!  Xxx,Yyy,Zzz  =  the  Pixel  addresses  in  each  direction  OUT  variable 
!  Xlmt, Ylmt, Zlmt  =  the  Pixel  extent  in  each  direction  IN  variable 
!  Sqrxy  =  the  size  of  a  XY  plane 
!  Ndnd  =  maximum  node 
!  Rrr  =  remaiders,  work  integer 
INTEGER  Rrr, Ndnd, Sqrss 
LET  Sqrxy=Xlmt*Ylmt 
LET  Ndnd=Sqrxy*Zlmt+l 
IF  Ndsrc>0  AND  Ndsrc<Ndnd  THEN 
LET  Zzz=l+ ( Ndsrc- 1 )  DIV  Sqrxy 
LET  Rrr= (Ndsrc-1 )  MOD  Sqrxy 
LET  Yyy=l+ ( Rrr  DIV  Xlmt) 

LET  Xxx=l+(Rrr  MOD  Xlmt) 

ELSE 

LET  Xxx=SHIFT(Xlmt, 1) 

LET  Yyy=SHIFT(Ylmt, 1) 

IF  Ndsrc>=Ndnd  THEN  Zzz=Zlmt+l 
IF  Ndsrccl  THEN  Zzz=0 
END  IF 
SUBEND 

!  [  ]  (  ]  function  FNWnr  [][]() 

DEF  FNWnr ( COMPLEX  Diel ( * ) , REAL  Frpx (*), COMPLEX  Din, REAL  Alferr, INTEGER  Nth) 
REM  Object  of  this  function  subprogram  is  to 
REM  find  the  exponential  averaging  factor  (or 
REM  percolation  related  factor)  "alf" 

REM  from  a  given  set  of  complex  number 
REM  dielectric  values  &  fractional  volume 
RF.M  weights  and  effective  or  resultant 
REM  complex  dielectric  value  of  composite 
REM  written  by  S.  Wallin,  4/91. 

REM  The  Wiener  or  exponential  averaging  factor 
REM  is  defined  as  follows: 

REM  DielO ( resultant ) ‘Alf  =  sum  {Frpx ( k) *Diel ( k) ‘Alf ) 

REM  where  DielO ( resultant )  =  response  of  composite 


94 


12030  REM  Alf  =  exponential  ave  or  Wiener  or  percolation  factor 

12040  REM  Frpx(k)  =  fractional  volumes  of  species  k 

12050  REM  Diel(k)  =  (dielectric)  response  of  species  k 

12060  COM  /Pass /Re lay (0: 7 ) 

12070  INTEGER  I , J , K, K1 , K2 , Kdo, Ns, Lsn , Lst , New 

12080  COMPLEX  DielO, DlogO, Alf , Alf 0, CO, Cl , C2 , C3 , Clg, Clg2 

12090  LET  Ns=Nth 

12100  IF  Ns<=0  THEN  STOP 

12110  ALLOCATE  COMPLEX  D log (Ns) 

12120  LET  Avg=0 

12130  LET  Diel0=Din 

12140  FOR  1=1  TO  Ns 

12150  IF  Diel ( I )<>CMPLX(0, 0 )  THEN  Avg=Avg+Frpx ( I ) 

12160  NEXT  I 

12170  REM  Normalize  ACTIVE  volume  to  total  1 
12180  FOR  1=1  TO  Ns 

12190  !  IF  AvgoO  THEN  LET  Frpx  ( I )  =Frpx  ( I )  /Avg 

12200  IF  D iel ( I ) =CMPLX (0,0)  THEN  Frpx(I)=0 

12210  NEXT  I 

12220  ! PRINT  "  Species  data:  (trial#,  complex  " ;CHR$ ( 238 ) ; ”  pair,  adj  vol  wt )  " 
12230  ! FOR  1=1  TO  Ns 

12240  ! PRINT  "  (#";I;"J  ( " ; REAL(Diel ( I ) ) ; " , " ; IMAG (Diel ( I ) ) ; " ) ” , DROUND ( Frpx ( I ) , 4 ) 
12250  ! NEXT  I 

12260  ! PRINT  "  [  eff]  ( " ; REAL ( DielO );","; IMAG (DielO );")”, 1 
12270  REM  Determination  of  slope  direction  by  log  wt 
12280  LET  D log0=CMPLX (0,0) 

12290  IF  D ielOoCMPLX (0,0)  THEN  DlogO=LOG ( DielO ) 

12300  LET  Clg=CMPLX (0,0) 1  Clg=Logarthimic  mean 

12310  LET  Clg2=CMPLX(0,0) 

12320  FOR  1=1  TO  Ns 

12330  LET  Dlog ( I ) =CMPLX (0,0) 

12340  IF  Diel ( I ) oCMPLX (0,0)  THEN  Dlog ( I ) =LOG ( P iel ( I ) ) -DlogO 

12350  LET  Clg=Clg+Frpx ( I ) *Dlog ( I ) 

12360  LET  Clg2=Clg2+Frpx ( I ) *Dlog ( I ) *Dlog ( I ) 

12370  NEXT  I 

12380  LET  Lsn=-SGN ( REAL ( Clg ) ) 

12390  1PRINT  ”  The  logarithmic  slope  is  " ; DROUND(REAL (Clg) , 4 ) ; 

12400  ! PRINT  DROUND ( IMAG ( Clg ), 4 );" indicates  " ;CHR$ ( 224 ) ; "  is  " ; 

12410  l IF  Lsn=l  THEN  1PRINT  "positive." 

12423  ! IF  Lsn=0  THEN  1PRINT  "at  zero." 

12430  ! I F  Lsn=-1  THEN  1PRINT  "negative." 

12440  REM  Extrema  values 

12450  LET  Lst=0 

12460  LET  Zst  =  0 

12470  FOR  1=1  TO  Ns 

12480  IF  Frpx ( I )<>0  THEN 

12490  LET  Tmp=Lsn* ABS ( D iel ( I ) ) 

12500  IF  Tmp>Zst  OR  Zst=0  THEN 

12510  LET  Zst=Tmp 

12520  LET  Lst= I 

12530  END  IF 

12540  END  IF 

12550  NEXT  I 

12560  IF  Lsn=0  THEN  Lst=0 

12570  LET  Alf  =CMPLX (0,0) 
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IF  Lst>0  AND  Lst<=Ns+l  THEN 

IF  Dlog ( Lst ) OCMPLX (0,0)  THEN  A1 f =-LOG ( Frpx ( Lst ) ) /Dlog ( Lst ) 
END  IF 

LET  C0=CMPLX(Lsn,0) 

IF  Clg2<>CMPLX (0,0)  THEN  C0=-2*Clg/Clg2 1 A  2nd  guess 
LET  Wt=ABS (CO) 

LET  Wt=l/ ( l+Wt*Wt ) IPelative  weights  for  ave  the  2  guesses 
LET  Alf=Alf+Wt* (CO-Alf) J Combined  lst  guesB 
1  PRINT  "  Guess  1  " ;CHR$ (224) ; "  =  " ; 

1  PRINT  DROUND ( REAL (Alf )  ,  4 ) ;DROUND ( IMAG (Alf ) , 4 ) 

LET  A1 f 0=CMPLX (0,0) 

LET  Alferr=l 
LET  J=2 
LET  New=0 

WHILE  AlfoAlfO  AND  J<32  AND  Alferr>l .  0E-13 
IF  New=l  THEN 

LET  A1 f 0=A1 f i Keep  track  of  last  iteration 
New=0 
END  IF 

LET  C1=CMPLX (0,0) 

LET  C2=CMPLX (0,0) 

LET  C3=CMPLX (0,0) 

LET  K=0!Keep  count  of  non-zero  terms 
FOR  1=1  TO  Ns 

LET  C0=A1 f *Dlog ( I ) 

IF  ABS{REAL(C0) )>700  THEN  lFailure  possible 
LET  Alf=-2*Clg/Clg2 
LET  A1 f 0=CMPLX (0,0) 

LET  C0=CMPLX (0,0) 

LET  C1=CMPLX (0,0) 

LET  Alferr=0!Set  to  exit 
END  IF 

IF  C0OCMPLX (0,0)  AND  Diel(I)<>0  THEN 
LET  C0=Frpx ( I ) *EXP (CO ) 

LET  C1=C1+C0 
LET  C2=C2+Dlog( I ) *C0 
LET  C3=C3+Dlog ( I ) *Dlog ( I ) *C0 
LET  K=K+llTally  another  non-zero  term 
END  IF 
NEXT  I 

IF  CloCMPLX (0,0)  AND  K>1  THEN  I  Log  func  deriv 
REM  0th,  lst,  &  2nd  logarithmic  derive 
LET  C2=C2/C1 
LET  C3=C3/C1-C2*C2 
LET  Cl=LOG (Cl ) 

REM  Newton-Raphson  estimate  via  2nd  degree  polynomial 
LET  K1=SGN ( REAL ( Cl ) ) 

LET  K2=SGN ( REAL ( C2 ) ) 

LET  C0=CMPLX (0,0) 

SELECT  K2 
CASE  0 
[PRINT  "  o"; 

IF  C3oCMPLX  (0,0)  THEN  LET  C0=-2*C1/C3 
IF  COoCMPLX (0,0)  THEN  LET  A1  f =Alf +K1  *SQR ( CO ) 

CASE  Lsn 
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1  3*30 
1 J140 
13150 
13160 
13170 
13180 
13190 
13200 
13210 
13220 
13230 
13240 
1  32  50 
1  3260 
1  12  10 
1  3280 
13290 
1  3  300 
13  310 
1  1320 
l  3  3  30 
1  3340 
1  3  350 
1  3360 
1  3  3  70 
1  3380 
1  3  390 
1  1400 
1  3410 
1  3120 
1  14  30 
1  J440 
1  1460 
1  1460 
1  14  /() 
1  3480 
1  3490 
1  1600 
1  3610 
1  1620 
1  16  30 
l  3640 
1  3660 
1  3660 
1  16  70 
1  3  680 
1  3  690 
1  3  600 
1  3610 
1  3620 
1  3 ft  30 
1  3640 
1  33.60 
1  3660 
I  3670 


! PRINT  "  +”; 

LET  C0=C2*C2-2*C1*C3 
IF  CO=CMPLX (0,0)  THEN 
LET  C0=2*C1/C2 
ELSE 

LET  C0=2*C1/ (C2+K2*SQR(C0) ) 

END  IF 

LET  Alf=Alf-CO  INew  estm  of  exp  factor 
CASE  -Lsn 
1  PRINT  " 

LET  C0=C2*C2-2*C1*C3 
IF  C0=CMPLX (0,0)  THEN 

IF  C3oCMPLX (0,0)  THEN  LET  C0  =  C2/C3 
ELSE 

IF  C3oCMPLX (0,0)  THEN  C0= ( C2+K2 *SQR (CO )  ) /C3 
END  IF 

LET  AI£=AIf-C0  INew  eetm  of  exp  factor 
END  SELECT 

LET  A1 f err=ABS ( REAL ( A1 f ) -REAL ( A1 f 0 ) ) +ABS ( I MAG ( Ai f ) -I MAG ( Alf 0 ) ) 

IF  ABS ( REAL (Alf ) ) >700  THEN  Alf =CMPLX ( Lsn/2 , 0 ) -Clg/Clg2/ ( 1+J ) 1  Retry 
LET  New=l  i Set  for  update 

END  IF 

! PRI NT  ”  Guess" ;  J;  ”  " ; CHR$ ( 224 ) ; “  =  " ;Alf ; "  varied* ” ;Alf err 
LET  J=J+1 
END  WHILE 

LET  Alferr=ABS(AlfO-Alf )  llteration  variance 

!  I F  AlferroO  THEN  1PRINT  "  Iteration  variance  =”;AIferr 
LET  Relay ( 6 ) =REAL ( Al f )  1  Relay  the  exp  ave  factor  =  relay(6&7) 

LET  Relay ( 7 ) =IMAG (Alf) 

RETURN  Alf 
FNEND 

!  |  )  (  ]  SUB  Pixs_by_hand  [  1  l  ]  I  1 

Mllli  Pix:i_by  hand 

!****•  Subprogram  to  hand  fill  a  3D  pixel  array 
COM  / Paso/Relay ( 0 : 7 ) 

COM  /Pixel/  INTEGER  Xmax , Ymax , Zmax , Pixl ( 1 : 8000 ), REAL  Xscl , Yscl , Zscl 
INTEGER  Xhnd, Yhnd, Zhnd,Nhnd 
EOR  Xhnd=l  TO  Xmax 

FOR  Zhnd=Zmax  TO  1  STEP  -1 
FOR  Yhnd=l  TO  Ymax 

LET  Nhnd=Xhnd+ ( Yhnd-1+ ( Zhnd-1 ) *Ymax ) *Xmax 

DISP  "Pixl  (  ”  ;  VAL$  ( Xhnd ;  VAL$  ( Yhnd )  ;  " ,  "  ;  VAL$  (  Zhnd 

orsp  "?  (previous=M ; VAL$ (Pixl (Nhnd )};”)”! 

INPUT  ”  " , Pixl (Nhnd ) 

NEXT  Yhnd 
NEXT  Zhnd 
NEXT  Xhnd 
S0BEND 

I  1  I  )  (  )  [  ]  [  1  (  )  l  ) 

SOB  Pixs  by_random( INTEGER  Spclmt) 

!***>  Subprogram  to  create  a  3D  pixel  array  of  random  shuffle 
com  / Pa ns /Re lay ( 0 : 7 ) 

com  /Pixel/  INTEGER  Xmax , Ymax , Zmax , Pix 1 ( 1 : 8000 ), REAL  XscI , Yscl , Zscl 
I NTKGER  Xrdm, Y rdm, Zrdm, Nrdm, Nsf , Spc in, Blks , Seed ,Xsf,Ysf,Zsf,Vsf 
INTEGER  t.nf  ,  Xvr,  Yvr,  Zvr 


97 


13680  REAL  Vrdm, Vtot , Vim ( 1 : 9 ) 

13690  !  Spclmt  is  integer  for  max  #  of  species 

13700  1  COM  /Pass/  uses  Relay(O)  as  vol(l]  Si  Relay (1)  seed 

13710  1  Relay(2)  as  random  along  axis  selector 

13720  LET  Spcin=Spclmt  (initialize  species  limit 

13730  LET  Vtot=0  IRelative  volume  accumulator 

13740  IF  Relay(l)=0  THEN  (uses  Relay(l)  as  random  seed 

13750  DISP 

13760  INPUT  "Random  seed?  ( neg  to  timer)  " , Seed 

13770  LET  Xsf=l 

13780  INPUT  "Shuffle  along  the  X  direction?  0=no  l=yes  (default- 1) 

13790  IF  Xsf<0  THEN  STOP 

13800  LET  Xsf = (Xsf >0 ) 

13810  LET  Ysf=l 

13820  INPUT  "Shuffle  along  the  Y  direction?  0=no  l=yes  (default  1)  ”,Ysf 

13830  IF  Ysf <0  THEN  STOP 

13840  LET  Ysf = ( Ysf >0 ) 

13850  LET  Zsf=l 

13860  INPUT  "Shuffle  along  the  Z  direction?  0=no  l=yes  (default: 1)  ",Zsf 

13870  IF  Zsf <0  THEN  STOP 

13880  LET  Zsf = ( Zsf >0 ) 

13890  ELSE 

13900  LET  Seed=INT ( . 000001+Relay ( 1 ) ) 

13910  LET  Vsf =INT ( . 5+Relay ( 2 ) )  !  Vsf  temporary  axis  selection 

13920  LET  Xsf=(BIT(Vsf,2)=0)  i  1,0  for  BIT(_,2)=0,1 

13930  LET  Ysf=(BIT(Vsf, 1)=0)  1  1,0  for  BIT(_,1)=0,1 

13940  LET  Zsf=(BIT(Vsf,0)=0)  1  1,0  for  BIT(_,0)=0,1 

13950  END  IF 

13960  LET  Lsf=(Xsf=0  AND  Ysf=0  AND  Zsf=0)  Ispecial  case,  no  shuffling 
13970  IF  Relay ( 1 )<2  THEN 

13980  PRINT  "Subprogram  " "Pixs_by_random"”  fills  a  pixel  box";Xmax; 

13990  PRINT  "x";Ymax;"x";Zmax; "randomly." 

14000  IF  Lsf  THEN  PRINT  "  NO  shuffles, 

14010  PRINT  "  Seed= " ; VAL$ ( Seed ) ; " ;  shuffles,  X ' b=" ; VAL$ ( Xsf ) ; 

14020  PRINT  ",  Y ' s=" ; VAL$ ( Ysf ) ; " ,  &  Z ' s=" ;VAL$ ( Zsf ) ; " . " 

14030  END  IF 

14040  LET  Xsf =Xsf * ( Xmax-1 ) + 1  1  either  1  or  Xmax  value 

14050  LET  Ysf =Ysf * ( Ymax-1 ) +1  !  either  1  or  Ymax  value 

14060  LET  Zsf=Zsf * ( Zmax-1 ) +1  !  either  1  or  Zmax  value 

14070  LET  Vsf =Xsf *Ysf *Zsf  !  #  of  elements  to  shuffle 

14080  IF  Lsf  THEN  Vsf =Xmax*Ymax*Zmax 

14090  LET  Xsf = (Xsf =1 ) * (Xmax-1 ) +1  J  either  Xmax  or  1  value,  revrsl 

14100  LET  Ysf =( Ysf = 1 )*( Ymax-1 ) +1  !  either  Ymax  or  1  value,  revrsl 

14110  LET  Zsf =( Zs f= 1 )*( Zmax- 1 )+ 1  l  either  Zmax  or  1  value,  revrsl 

14120  IF  Vs f  =  1  THEN  PRINT  "TRIVAL  Pixl,  random  shuffling  along  no  direct  ion!' 

14130  IF  Seed<0  THEN  RANDOMIZE  TIMEDATE  MOD  32767 

14140  IF  Seed>0  THEN  RANDOMIZE  Seed 
14150  FOR  Nrdm= 1  TO  Spcin 
14160  IF  Spclmt=Spcin  THEN 

14170  IF  Relay(l)>0  THEN  luse  Relay(0)  as  volume  fraction 

14180  IF  Nrdm=l  THEN  LET  Vrdm=FRACT ( Re  1  ay ( 0 ) ) 

14190  IF  Nrdm=2  THEN  LET  Vrdm= 1 -FRACT ( Rel ay ( 0 ) ) 

14200  IF  Nrdm=3  THEN  LET  Vrdm=-1 

14210  ELSE 

14220  DISP  "Give  occupation  for  pixel  species  ( " ; VAL$ ( Nrdm) ; " ) " ; 
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14  2  30 
14240 
14260 
14260 
142  70 
14280 
14290 
14  300 
14310 
14320 
1  4  1  30 
1 .4  340 
14  160 
14360 
14  370 
14  380 
14  390 
14400 
14410 
14420 
144  30 
144*0 
14460 
1  4  460 
14470 
14480 
14490 
14  600 
14  6  10 
14  620 
1  4630 
1  4640 
1  4660 
14  660 

146  70 
1  4  OHO 
14  690 
14  600 
14610 
1  4620 
1  46  10 
14640 
I  4660 
14  660 
14670 
14680 
1  4690 
14700 
14  7  10 
14720 

147  10 
14/40 
I  4  7  60 
1  4  7  60 
I  4  /  70 


OISP  "  of  ( " ; VAL$ ( Spc lmt ) ; " ] ? 

INPUT  "(or  <0  ends  sequence)  “,Vrdm 
END  IF 

IF  Vrdm<0  THEN 

LET  Spclmt=Nrdm-l 
ELSE 

LET  Vtot=Vtot+Vrdm 
END  IF 
END  IF 

IF  Nrdm<=Spclmt  THEN 
LET  Vlm(Nrdm) =Vtot 
ELSE 

LET  Vlm(Nrdm) =0 
END  IF 
NEXT  Nrdm 

FOR  Nrdm=l  TO  Spclmt 

IF  Vtot=0  AND  Spclmt>0  THEN 

Vim (Nrdm) =INT( . 5+Vsf *Nrdm/Spclmt ) 

ELSE 

V lm ( Nrdm) = INT ( ,5+Vlm(Nrdm) *Vsf/Vtot) 

END  IF 

! PRINT  “v” ; VAL$ ( INT ( Vim ( Nrdm) ) ) ;  Idebugger 
NEXT  Nrdm 

LET  Blks=l  1  keep  track  of  blocks  used 

FOR  Nrdm=l  TO  Vsf  ldispense  Pixels  as  occup.  specs 

WHILE  Nrdm>Vlm ( Blks )  AND  Blks<Spclmt 

LET  Blks=Blks+l  Iwhen  level  exhausted  move  on 

END  WHILE 

LET  Pixl (Nrdm) =Blks 
NEXT  Nrdm 

IF  not  (Lsf)  THEN  lie,  normal  shuffling 

FOR  Nrdm=l  TO  Vsf  Ishuffle  Pixels 

REPEAT 

LET  Nsf  = INT ( RND*Vsf ) 

UNTIL  NsfoNrdm  AND  Nsf<Vsf 

I.ET  Blks  =  Pi.xl  (Nrdm)  !  swap 

LET  Pixl (Nrdm) =Pixl (Nsf +1 ) 

LET  Pixl (Nsf+1 )=Blks 

!  PRINT  " s" ; VAL$ ( Blks ) ;  1 1 SHUFFLing  sequence , debugger 

NEXT  Nrdm !  1  SHUFFLE  sequence 
1  PRINT 

IF  NOT  (Xsf=l  AND  Vsf=l  AND  Zsf=l)  THEN  lif  partial,  copy  out 
LET  Nsf =Vsf 

FOR  Zrdm=Zmax  TO  Zsf  STEP  -1 
FOR  Yrdm=Ymax  TO  Ysf  STEP  -1 
FOR  Xrdm=Xmax  TO  Xsf  STEP  -1 

LET  Nrdm=FNOde_mk ( Xrdm, Yrdm, Zrdm, Xmax, Ymax , Zmax ) 

LET  Pixl (Nrdm) =Pixl(Nsf) 

LET  Pixl ( Nsf ) =0 
LET  Nsf =Nsf-l 
NEXT  Xrdm 
NEXT  Yrdm 
NEXT  Zrdm 

END  IF  1  end  if  not  entire  Pixl  array 

FOR  Zrdm-1  TO  Zmax 
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14780  LET  Zvr=Zsf 

14790  IF  Zvr=l  THEN  Zvr=Zrdm 

14800  FOR  Yrdm=l  TO  Ymax 

14810  LET  Yvr=Ysf 

14820  IF  Yvr=l  THEN  Yvr=Yrdm 

14830  FOR  Xrdm=l  TO  Xmax 

14840  Nrdm=FNOde_mk( Xrdm, Yrdm, Zrdm, Xmax, Ymax , Zmax ) 

14850  LET  Xvr=Xsf 

14860  IF  Xvr=l  THEN  LET  Xvr=Xrdm 

14870  LET  Nsf=FNOde_mk ( Xvr , Yvr, Zvr, Xmax, Ymax, Zmax) 

14880  Pixl (Nrdm) =Pixl (Nsf ) 

14890  NEXT  Xrdm 

14900  NEXT  Yrdm 

14910  NEXT  Zrdm 

14920  END  IF  lend  if,  NOT( Lsf ) =shuf f le  OK 

14930  SUBEND 

14940  !(](](](  1  [)[  I  I  I 

14950  SUB  Pixs  by_2block( INTEGER  Stype) 

14960  !***>  Subprogram  to  create  a  3D  pixel  array  of  fractal  or  sen  1  >  :im 
14970  !***>  grain  sizing 
14980  COM  /Pass/Relay(0:7) 

14990  COM  /Pixel/  INTEGER  Xmax  ,  Ymax  ,  Zmax  ,  Pixl  ( 1 :  8000  ),  REAL  Xscl ,  Yuri  ,  Y.h<  1 
15000  INTEGER  Nran , Mran , Nwth , StypO, Cel 1 , Qnza , Bsz , Jf 1 1 , Kf 1 1 , Lf 1 1 , Nf  t 1 , Vf  t  1 
15010  INTEGER  Af t 1 , Bf t 1 , Krc , Kqc , Shldr , Xf t 1 , Yf t 1 , Z f t 1 , Xpmx , Ypmx , Zpmx 
15020  INTEGER  Glv,Myr,Cycl 
15030  REAL  Vsth , Val 1 , Vact ( 1 : 9 ) 

15040  !  Stypa  is  integer  for  max  #  of  species,  may  be  changed  by  SUB 

15050  1  COM  /Pass/  uses  Relay(0)  as  volfl]  &  Relay(l)  seed 

15060  LET  StypO=Styps  ! initialize  species  limit 

15070  LET  Vf t 1=SHIFT ( Xmax , 1 ) * SHI FT ( Ymax , 1 } * SHI FT ( Zmax , 1 )  J/2x2x2s 
15080  LET  Jftl=Xmax*Ymax  Ipixels  on  a  Z  level 

15090  LET  Xpmx=Xmax-l  Snext  to  maximums 

15100  LET  Ypmx=Ymax-l 

15110  LET  Zpmx=Zmax-l 

15120  LET  Nf t 1=SHIFT ( Vf t 1 , 1 )  Jabout  50%,  2x2x2s 

15130  ALLOCATE  INTEGER  Sqnc(l:Nftl)  larray  of  2x2x2  locations 

15140  LET  Vall=0  IRelative  volume  accumulator 

15150  IF  Relay(l)=0  THEN  !uses  Relay(l)  as  random  seed 

15160  DISP 

15170  INPUT  "Random  seed?  ( neg  to  timer)  ”,Qnza 

15180  ELSE 

15190  LET  Qnza=INT ( . 000001+ Re lay { 1 ) ) 

15200  END  IF 

15210  IF  Relay ( 1 ) <2  THEN 

15220  PRINT  "Subprogram  " "Pixs_by_2block" "  fills  a  pixel  box";Xmax; 

15230  PRINT  ”x" ; Ymax ; ”x" ; Zmax; "randomly . " 

15240  PRINT  "  shuffle  addr: 

15250  END  IF 

15260  LET  Bsz=Xmax*Ymax*Zmax 

15270  IF  Nftl<2  OR  Vftl  =  0  THEN  1  if  Pixl  box  small 

15280  FOR  Nran= 1  TO  Bsz 

15290  Pixl (Nran ) =BIT(Nran, 0) 

15300  NEXT  Nran 

15310  PRINT  ”  Pixel  box  too  small  to  fractalize,  try  regular  RANDOM” 

15320  ELSE 


16  3  30 
16340 
15350 

15  360 

16  370 
15380 
16  390 
15400 
l  64  10 
1  6420 
1  64  10 
16440 
1  5460 
1  6460 
164  70 
1  6480 
1  54r,0 
1  5500 
1  5  5  i  0 
15520 
15530 
1  6640 
1  6650 
1  5  660 
1  66  7  0 
1  6  680 
1  5590 
1  6600 
1  6610 
1  6020 
l  60  30 
1  6040 
1  6  660 
1  6660 
1  6670 
15680 
1  6690 
1  6  700 
167  1  0 
1  6720 
I  6  /  1(1 
1  5740 
1  6760 
1  6  760 
1  6  /  7  0 
1  6  /HO 

I  6790 
1  68  00 
1  6810 
I  6  820 
l  68  30 
1  6840 
1  6860 
1  6.9,0 
1  687  0 


IF  Bsz=l  THEN  PRINT  "TRIVAL  Pixl,  random  shuffling  along  no  direction!" 
IF  Qnza<0  THEN  RANDOMIZE  TIMEDATE  MOD  32767 
IF  Qnza>0  THEN  RANDOMIZE  Qnza 
frOR  Nran=l  TO  StypO 
IF  Styps=StypO  THEN 

IF  Relay(l)>0  THEN  luse  Relay (0)  as  volume  fraction 

IF  Nran=l  THEN  LET  Vsth=FRACT( Relay (0) ) 

IF  Nran=2  THEN  LET  Vsth=I-FRACT ( Relay ( 0 ) ) 

IF  Nran=3  THEN  LET  Vsth=-1 
ELSE 

DISP  "Give  occupation  for  pixel  species  [ ” ;VAL$ ( Nran ; 

DISP  "  of  [ " ; VAL$ ( Styps ) ;  "  ]  ? 

INPUT  "(or  <0  ends  sequence)  ",Vsth 
END  IF 

IF  Vsth<0  THEN 
LET  Styps=Nran-l 
ELSE 

LET  Vall=Vall+Vsth 
END  IF 
END  IF 

IF  Nran<=Styps  THEN 
LET  Vact (Nran) =Vall 
ELSE 

LET  Vact(Nran)=0 
END  IF 
NEXT  Nran 

FOR  Nran=l  TO  Styps 

IF  Val 1=0  AND  Styps>0  THEN 

Vact(Nran)=INT( . S+Bsz*Nran/Styps ) 

ELSE 

Vact(Nran)=INT( . 5+ Vact ( Nran ) *Bsz/Val 1 ) 

END  IF 

SPRINT  " v" ; VAL$ (INT( Vact (Nran) )) ;  ! debugger 
NEXT  Nran 

LET  cell=l  ! keep  track  of  blocks  used 

LET  Kftl=0  1  count  Pixl=(l)s 

FOR  Nran=l  TO  Bsz  [dispense  Pixels  as  occup.  specs 

WHILE  Nran>Vact (Cell )  AND  Cell<Styps 

LET  Cell=Cell+l  Iwhen  level  exhausted  move  on 

END  WHILE 

LET  Pixl (Nran) =Ce 11 

IF  Cell=l  THEN  Kftl=Kftl+l  I  increment  count  of  Pixl=(l]s 
NEXT  Nran 

FOR  Nran=l  TO  Nftl  !  make  2x2x2  locations 

REPEAT 

I.ET  S h  l d r  =  1 

REPEAT  1  get  randomly  X  up  to  Xmax-1,  etc 

LET  Xftl  =  INT( RND* Xpmx ) 

UNTIL  Xf t l<Xpmx 
REPEAT 

LET  Y  f  1 1  =  INT ( RHD*Ypmx ) 

UNTIL  Yftl<Ypmx 
REPEAT 

LET  Z  f  1 1  =  I  NT ( RND*  Zpmx ) 

UNTIL  Zf tl<Zpmx 
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15880 
15890 
15900 
15910 
15920 
15930 
15940 
15950 
15960 
15970 
15980 
15990 
16000 
16010 
16020 
1  6070 
16040 
16050 
16060 
16070 
If  080 
16090 
16100 
16110 
16120 
16130 
16140 
16150 
16160 
16170 
16180 
16190 
16200 
16210 
16220 
162  70 
16240 
16250 
16260 
16270 
16280 
16290 
16300 
16310 
16320 
16330 
16340 
16350 
16360 
16370 
16380 
1  6390 
16400 
16410 

1  0  4  2  u 


LET  Nwth= 1+X f 1 1+ Y f 1 1 *Xmax+Zft 1  * J f 1 1  Iformulate  Pixl  address 
FOR  Mran=l  TO  Nran-1  1  check  if  good  new  address 

LET  Aftl=Nwth-Sqnc(Mran)  1  address  differences 
IF  Aftl=0  THEN  1  at  same  location 

LET  Shldr=0 

ELSE  1  or  neighbor  checking 

LET  Zf 1 1  =  ABS ( Af 1 1  DIV  Jftl) 

LET  Xf tl=ABS ( Af tl  MOD  Jftl) 

LET  Zftl=ABS ( Xftl  DIV  Xmax) 

LET  Xf t 1=ABS (Xftl  MOD  Xmax) 

LET  Bf t 1~ ( Xf t 1>1  OR  Yftl>l  OR  Zftl>l)  Itest,  not  overlap 
1  PRINT  VAL$(Bftl) ; 

IF  NOT  Bftl  THEN  Shldr=0 

END  IF  lendif,  neighbor  checking,  Aftl 

NEXT  Mran  (next  checking  in  sequence 

IF  Shldr  THEN  Sqnc { Nran ) =Nwth  (assign  another  2x2x2 
UNTIL  Shldr 
NEXT  Nran 

FOR  Nran= 1  TO  Nftl-1  Ishuffle  2x2x2s 

LET  Mran=Sqnc ( Nran )  ! randomly  exchange  in  sequence 

REPEAT  lwith  another  higher  up 

LET  Nwth=lNT(RND* (Nftl-Nran) ) 

UNTIL  Nwth< (Nftl-Nran) 

LET  Nwth=Sqnc(Nwth+Nran+l ) 

IF  Relay(l)<2  THEN  PRINT  Mran; ”<=>" ;Nwth; " ; ” ;  (exchange  detail 
FOR  Krc=0  TO  7  1  range  thru  Pixls  in  2x2x2s 

LET  Aftl=BIT(Krc,2)+BIT(Krc, 1) *Xmax+BIT ( Krc , 0) *Jftl 
LET  Cell=Pixl (Mran+Aftl ) 

LET  Pixl (Mran+Aftl ) =Pixl (Nwch+Aftl ) 

LET  Pixl ( Nwth+Af t 1 ) =Cell 
NEXT  Krc 
NEXT  Nran 

IF  Relay ( 1 ) <2  THEN  PRINT 

FOR  Nran=l  TO  Nftl  l  add  random  orientations 

LET  Mran=Sqnc ( Nran ) 

REPEAT  1  get  a  random  f 

LET  Krc= INT ( RND* 1 6 ) 

UNTIL  Krc< 16 

LET  Kqc=SHIFT(Krc,2)  1  0=none  !<>Xs  2<>Yo  3<>Zs 

IF  Kqc>0  THEN  1  Kqc>0  >=>  random  exchanges 

FOR  Glv=0  TO  1  !  do  2  levels  the  same 

FOR  Myr=0  TO  BIT(Krc,l)  !  0=diag  l=flatwise  (2  pannes) 

LET  Xftl=Glv  !  1st  exchange  relv  coordinates 

LET  Y ftl=Myr 
LET  Z  f 1 1=BIT ( Krc , 0 ) 

IF  Myr  THEN  Zftl=  NOT  Zftll  reverse  2nd  pass  of  Myr 
FOR  Cycl=2  TO  Kqc  I  cyclic  permutation 

LET  Cell=Zftl 
LET  Zf tl=Y f tl 
LET  Y f t l=Xf 1 1 
LET  Xf t l=Cel 1 
NEXT  Cyc 1 

LET  Aftl=l+Xftl+Yftl* Xmax  +  Zftl*Jft  1 
1  PRINT  "  <"  ; VAL$ (Mran  );">("  ;  VAI,$  (Xftl);",";  VAI.$  (Ytt  I  , 

! PR  I  NT  VAL$ (Z ft  !);")< 
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LET  Xftl=Glv  1  2nd  exchange  coordinates 

LET  Yftl=Myr  1  same  as  1st  but  add  NOTs 

LET  Zftl=BIT( Krc, 0 ) 

IF  Myr  THEN  Zftl=  NOT  Zftll  reverse  upon  2nd  pass 
IF  B I T ( Krc , 0 )  =  0  OR  BIT(Krc,l)=0  THEN  Yftl-  NOT  Yftl 
IF  BIT(Krc,0)=l  OR  BIT{Krc,l)=0  THEN  Zftl=  NOT  Zftl 
FOR  Cycl=2  TO  Kqc  !  cyclic  permutation 

LET  Cel l=Zftl 
LET  Z  f 1 1  =  Y  f 1 1 
LET  Y f t l  =  Xf 1 1 
LET  Xftl=Cell 
NEXT  Cyc 1 

LET  Bftl=l+Xf tl+Yf tl*Xmax+Zftl* Jf tl 
!  PRINT  "  (  "  ;  VAL$  (  Xf  1 1  )  ;  "  ,  ”  ;  VAL$  (  Yf  tl )  ;  "  ,  "  ;  VAL$  (  Zftl )  )  *'  ; 

LET  Cell=Pixl (Mran+Aftl ) 1  swap 
LET  Pixl (Mran+Aftl ) =Pixl (Mran+Bftl ) 

LET  Pixl (Mran+Bftl ) =Cell 
NEXT  Myr 
NEXT  Civ 

END  IF  1  endif,  Kqc>0,  random  exchanges 

FOR  Krc  0  TO  7  1  tag  the  large  blocks 

LET  Aftl  1 »BIT( Krc, 2 ) +BIT(Krc, 1 ) *Xmax ♦ BIT ( Kr c , 0) * Jf tl 
LET  Pi xl (Mran+Aftl ) =BINCMP(Pixl (Mran+Aftl ) ) 

NEXT  Krc 
NEXT  Nr an 

IF  ( Baz-SH IFT (Nf t 1 , -3 ) ) >2  THEN  !  shuffle  rest  unmarked 
FOR  N  ran  -  I  TO  Bez 

IF  Pixl ( Nran ) >=0  THEN 
REPEAT 

LET  Mran=Bsz*RND 

r F  Mran-cBsz  THEN  !  test  for  Pixl  marked/unmarked 

LET  Myr=Pixl (Mran+1 ) 

ELSE 

LET  Myr  -1 
END  IF 

UNTIL  MranoNran  AND  Myr>-0 
LET  Mi  an  Mran+1 

LET  IV'  1  1  •  P i x 1 ( Nran )  1  swap 

LET  Pixl (Nran)  Pixl (Mian) 

LET  Pi x 1  (Mian)  Cel  1 

END  IK  !  end  if,  Pixl  ten! 

NEXT  Nran 

END  IE  1  end  if,  shuffle  unmarked 

LET  ('ell  0  !  start  to  count  Pixl-|l]s 

Eon  Nran  1  TO  Buz  !  remove  marking 

IF  Pixl  (Ni.inp  0  THEN  Pixl  (Nran)  Mil  NCMP  (Pixl  ( Nran  )  ) 

IE  Pixl (Nran)  1  THEN  Cell=Cell+l 
NEXT  Nran 

IE  t *e i 1 <  >K f t 1  THEN  PRINT  "  Lost/qained  something  in  SUB  shuffle' 
! PR  I  NT 

! PR  I  NT  .Nqne ( * ) 

DEALLOCATE  Sqm  ( * ) 

END  IE  l«*nd  if,  for  big  emit  Pixl  box 

MJIIENb 

1111(1(11)111 


1  0  ! 


16980 
16990 
17000 
17010 
17020 
17030 
17040 
17050 
17060 
17070 
17080 
17090 
17100 
17110 
17120 
17130 
17140 
17150 
17160 
17170 
17180 
17190 
17200 
17210 
17220 
17230 
17240 
17250 
17260 
17270 
17280 
17290 
17300 
17310 
17320 
17330 
17340 
17350 
17360 
17370 
17380 
17390 
17400 
17410 
17420 
17430 
17440 
17450 
17460 
17470 
1  7480 
1749C 
17500 
17510 
17520 


SUB  Pixs_by_ellps 

COM  /Pass/Relay(0:7) 

COM  /Pixel/  INTEGER  Xmax , Ymax , Zmax, Pixl ( 1 : 8000 ), REAL  Xsc 1 , Ybc 1 , Zac  1 
!***>  Creates  a  3D  pixel  array  of  an  ellisoidal  inclusion  in  a  host 
INTEGER  Blkcl , Blkc2 , Boxz , Btst , Dsr , Impv , Rol 1 , Tal ly , Uyou , XI v, V 1 v, Zlv 
REAL  Chgu, Flvr , Frsl , Frs2 , Guess 

REAL  Xgu ,  Ygu ,  Zgu  ,Vlps,Xlps,Ylps,Zlps,Xflv,Yflv 
LET  Boxz=Xmax*Ymax*Zmax 

IF  Boxz<=0  THEN  PRINT  Xmax ; "x Ymax ; "x" ; Zmax ;"?? ?  -n  SUB  ellps" 

LET  Uyou= ( Relay (0 ) =0 )  luser  input  signal 

IF  Uyou  THEN 
DISP 

PRINT  "Filling  pixels  with  ellipsoid  inclusion  imbedded  in" ; 

PRINT  "  a  host  (a  binary)" 

LET  Frsl=l 

IF  Relay ( 0 ) >0  THEN  Frsl=Relay ( 0 ) 

DISP  "Give  occupation  by  species  [1]?  (def ault=" ; VAL$ ( Frsl ) ; 

INPUT  ")  " , Frsl 
LET  Frs2=l 

IF  Frsl>0  AND  Frsl<l  THEN  Frs2=l~Frsl 

DISP  "Give  occupation  by  species  (2)?  ( def au It = " ; VAL$ ( Frs2 ) ; 

INPUT  ")  " , Fr82 

DISP  "Inclusion  role?  0)=smaller  species,  l)=species  #1,"; 

INPUT  "  2)=species  #2  ",Roll 
IF  Rol 1<0  THEN  STOP 


LET  Xlps= 1 

INPUT  "Ellipsoid  > 

LET  Ylps=l 

INPUT  "Ellipsoid  \ 

LET  Zlps=l 

INPUT  "Ellipsoid  2 

PRINT  "Subprogram 


axis  length?  (default=l)  ",Xlps 
axis  length?  (default=l)  ",Ylps 


IRelay (0)=volume  fraction  of  |1| 

lRelay(4)  is  role  reversal  flag 
IRelay(l)  is  X  ellipse  axis 


1  Relay (2)  is 
IRelay (3)  is 
lend  if, Uyou 


ell  ipse 
ell ipse 


axis 

axis 


axis  length?  (default=l)  ",Zlps 
'"Pixs_by_ellps""  fills  a  pixel  box";Xmax; 
PRINT  "x" ; Ymax; "x” ; Zmax; "with  an  ellipsiod" 

ELSE 

LET  Frsl=FRACT ( Relay ( 0 ) ) 

LET  Frs2=l-Frsl 
LET  Rol 1= ( Relay ( 4 ) > . 5 ) 

LET  Xlps=Relay ( 1 ) 

LET  Y lps=Relay ( 2 ) 

LET  Z lps=Relay ( 3 ) 

END  IF 

IF  Rol 1>2  THEN  LET  Rol 1 =2-BIT ( Rol 1 , 0 ) 

LET  Frs2=Frsl+Frs2 

IF  Frs2>0  THEN  Fr s 1 =Fr s 1 /Fr s2  INormalize  fractions 

LET  Frs2=l-Frsl 

IF  Roll=0  THEN  Rol 1= 1 + ( Frs 1 > . 5 )  Iprogram  selects  inclusion  i 

IF  Rol 1=1  THEN  Dsr=INT< . 5+ Boxz* Frsl ) 

IF  Rol 1  =  2  THEN  Dsr = I  NT  < . 5  + Boxz  * Frs 2 ) 

IF  Xlps<=0  THEN  Xlps= 1 
IF  Y lps<=0  THEN  Ylps=l 
IF  Zlps<=0  THEN  Zlps= 1 
LET  Vlps=. 5*PI *Xlps*Ylps*Zlps 
LET  lmpv=0 

LET  Guess= ( 3*Dsr /VI ps )  ( 1 / 3 ) 

LET  Blkcl  =  SHIFT(-l,  1) 


ole 


13*ellipse  quandrant  user  size  pa ram 

linitial  guess  at  axis  Healing  factor 
[assume  worst  case  to  start, MAX  I  NT 
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1  7  5  JO 
1  /MO 
1  7  55  0 
'  7560 
17570 
17580 
17590 
17600 
17610 
17  670 
17630 
17640 
17650 
17  660 
17670 
17680 
1  7  690 
1  7  7  00 
17710 
17720 
17730 
17  740 
1  7  7  50 
17  760 
17  7  70 
1  7780 
1  7  790 
17800 
17310 
17820 
1  78  30 
1  7840 
1  7850 
1  7  860 
1  7870 
]  7  8 HO 
1  7  890 
1  7  900 
1  79  1  0 
1  7920 
I  79  JO 
l  7940 
I  7950 
1  7900 
1  79  70 
1  7980 
1  7  990 
18000 
18010 
18020 
1  80  90 
I  8040 
1  8050 
1  8060 
I  80  70 


I,ET  Blkc2  =SHI FT (-1,1)  lassume  worst  case  to  start, MAXINT 

LET  lmpv=4  1  least  3  guesses 

REPEAT  1  until  guess  improved 

LET  Impv=Impv-l 
LET  Xgu=Guess*Xlps 
LET  Ygu=Guess*Ylps 
LET  Zgu=Guess*Zlps 
LET  Xgu=Xgu*Xgu 
LET  Ygu=Ygu*Ygu 
LET  Zgu=Zgu*Zgu 
LET  Tal ly=0 
FOR  Xlv=l  TO  Xmax 

LET  Xflv=((.5+Xlv)*(.5+Xlv))/Xgu 
FOR  Ylv=l  TO  Ymax 

LET  Yflv=((.5+Ylv)*(.S+Ylv))/Ygu 
FOR  Zlv=l  TO  Zmax 

LET  Flvr= ((.5+Zlv)*(. 5+Zlv)) /Zgu+Xf lv+Yf lv 
LET  Tally=Tally+(Flvr<=l)  tTally  pixels  within  ellipsoid 
NEXT  Zlv 
NEXT  Ylv 
NEXT  X 1 v 

LET  Btst=Tal ly-Dsr  !How  far  off  the  mark  is  the  Tally 

!  PRINT  '*c";VAL$(Btst)  ; 

IF  Btst<0  THEN 

IF  -Btst<Blkcl  THEN  1  new  lower  minumum  found 

LET  Blkcl=-Btst 
LET  Impv=3 
END  IF 
END  IF 

IF  Btst>0  THEN  1  new  upper  maximum  found 

IF  Btst<Blkc2  THEN 
LET  Blkc2=Btst 
LET  Impv=3 
END  IF 
END  IF 

LET  Chgu=Btst/ (Guess *Guess *Vlps )  [estimate  correction  to  guess 
IF  lmpv>0  THEN  Guess=Guess-Chgu 

IF  Guess<=0  AND  lmpv>0  THEN  Guess= (Guess+Chgu ) * . 5 
UNTIL  lmpv<=0  [until  nolonger  improves 

! PRINT 

IF  GuensoO  THEN 

IF  Out*8B<0  THEN  Guess  =  -Guess 
FOR  X  1  v=  1  TO  Xmax 

LET  Xf  lv=  (  (  .  5+Xlv)  *  (  .  5+Xlv)  )/Xgu 
FOR  Y1  v=  1  TO  Ymax  [assign  Pixls 

LET  Yf  lv= ( ( . 5  +  Ylv) * ( . 5+Ylv) ) /Ygu 
FOR  Zlv=l  TO  Zmax 

LET  Flvr=( ( . 5+Zlv) * ( . 5+Zlv) ) /Zgu+Xf lv+Yf lv 
LET  Tal ly=Xlv+ ( Ylv-1+ (Zlv-1 ) *Ymax) *Xmax 
IF  Rol 1=1  THEN  LET  Pix 1 ( Ta 1 ly ) =1+ ( Flvr>l ) 

IF  Rol 1=2  THEN  LET  Pixl (Tally ) =2- ( Flvr>l ) 

NEXT  Zlv 
NEXT  Ylv 
NEXT  X 1 v 
IF  Uyou  THEN 
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18080 
18090 
18100 
18110 
18120 
18130 
18140 
18150 
18160 
18170 
18180 
18190 
18200 
18210 
18220 
18230 
18240 
18250 
18260 
18270 
18280 
18290 
18300 
18310 
18320 
18330 
18340 
18350 
18360 
18370 
18380 
18390 
18400 
18410 
18420 
18430 
18440 
18450 
18460 
18470 
18480 
18490 
18500 
18510 
18520 
18530 
18540 
18550 
18560 
18570 
18580 
18  590 
18600 
18610 
18620 


PRINT  "  whose  size  is:  X  axis=" ; VAL$ ( DROUND ( Xlps*Guess , 4 ) ) ; 
PRINT  ",  Y  axis=" ;  VAL$ (DROUND (Y lps*Guess , 4 ) ) ; 

PRINT  ”,  &  Z  axis=” ;VAL$ (DROUND (Zlps*Gueas, 4 " 

END  IF 

END  IF  lend  if  guessoO 

SUBEND 

SUB  Pix_by_correlat 
COM  /Pass/Relay (0 : 7 ) 

COM  /Pixel/  INTEGER  Xmax , Ymax , Zmax , Pixl ( 1 : 8000 ), REAL  Xscl , Yscl , Zsc 1 
INTEGER  Bcr 1 , Crr 1 ,Gcrl , Icrl, Jcrl, Kcrl, Lcrl , Ncrl ,Qcr 1 , Scrl ,Tcr 1 , Zcr l 
INTEGER  Xc,Yc,Zc,Xdf,Ydf,Zdf 
REAL  Arel , Prel , Rrel , Vrel , Vsm, Frel ( 1:9) 

LET  Zcr l=Xmax*Ymax  !  Pixel  box  area  of  ?  section 

LET  Bcrl=Zcrl*Zmax  1  Total  max  Pixels 

ALLOCATE  Tabl ( 1 : Bcr l ) , Wre 1 ( 0 : Bcr 1 )  I  For  correlation  weighting 
MAT  Pixl=(0)  1  Need  to  zero  out  pixels 

LET  Vsm=0  1  Volume  fraction 

LET  Crr 1= INT ( Relay ( 2 ) )  !  Pass  correlation  selection 

IF  Crrl=l  OR  Crrl=4  THEN  Prel=Relay ( 3 )  !  Pass  correlation  length 

IF  Relay (1)=0  THEN 
DISP 

INPUT  "Random  seed?  (negative  to  timer )", Scrl 

DISP  "Correlation?  none=0  expon=l  inverse=2  inv  square=3"; 

DISP  ”  power  law=4  (default=" ;VAL$ (Crrl ) ; 

INPUT  " ) " , Crrl 
LET  Relay(2)=Crrl 
ELSE 

LET  Scrl=( .00000000001+Relay(l) ) 

END  IF 

IF  Scrl>0  THEN  RANDOMIZE  Scrl  1  Seeding  random  generator 
IF  Scrl<0  THEN  RANDOMIZE  TIMEDATE  MOD  32767 


LET  Vrel= ( Xmax-1 ) * ( Xmax-1 ) + ( Ymax-1 ) * ( Ymax-1 ) + ( Zmax- 1 ) * ( Zmax- 1 ) 

1LET  Vrel=Xmax*Xmax+Ymax*Ymax+Zmax*Zmax  f  =hypotenuse  diag  squared 
SELECT  Crrl 

CASE  =1  !  exponential  correlation 

IF  Relay ( 1 ) =0  THEN 

DISP  "Correlation  length?  (in  pixel  units,  default="; 

DISP  VAL$ ( Prel ) ; 

INPUT  " ) ” , Prel 
END  IF 

IF  Prel=0  THEN  Prel=SQR ( Vre 1 ) * . 5  !  if  zero,  then  .5  diag 

LET  Relay ( 3 ) =Prel 

LET  Arel=EXP ( SQR (Vrel ) /Prel )  !  field  weighting  factor 

CASE  =2  !  inverse  correlation 


LET  Arel=SQR ( Vrel ) 

CASE  =3  !  inverse  square  correlation 

LET  Arel=Vrel 


CASE  =4  !  power  law  correlation 

IF  Relay ( 1 ) =0  THEN 

DISP  "Power  law?  (l=inverse,  2=inv  sqr,  etc,  default-"; 
DISP  VAL$ ( Prel ) ; 

INPUT  ” ) " , Prel 
LET  Relay ( 3 ) =Prel 
END  IF 

IF  Pre 1 =0  THEN 
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18630 
1  8640 
1  8690 
1  8660 
!  8670 
18680 
1  H  6  '1 0 
1  H  700 
18710 

18  770 
187  30 
187  40 
1  8  7  S  0 
18760 
18770 
1R7R0 
18790 
18800 
18810 
1  8820 
18880 
18840 
1  8860 
1  8860 
18870 
18880 
1  8800 
18900 
18910 
18920 
189  30 
1  89  40 
1  89  SO 
189  60 
18970 
1  8980 
1  8990 
1  9000 
19010 
1  9020 
1  90  10 
1  9010 
1  9060 
1  9060 
1  9070 
I  9080 
1  9090 
1  9  1  00 

19  110 
19  I  20 
1  9  1  30 
19  140 
1  9  1  60 
1  9  1  60 
I  9  I  70 


1  Species  tally 
1  up  to  9  species 

1  Has  not  ended  sequence 
1  get  next  occupation 


LET  Crr 1 =0 
ELSE 

LET  Arel=Vrel‘ <Prel*.S) 

END  IF 
CASE  ELSE 
LET  Arel= 1 
END  SELECT 
LET  Ter  1 *0 
FOR  Ncrl-1  TO  9 
LET  Frel ( Ncr 1 ) =0 
IF  Ter 1=0  THEN 

IF  Relay ( 1 ) >0  THEN 

IF  Ncrl=l  THEN  Vre 1=FRACT ( Relay ( 0 ) ) 

IF  Ncr 1=2  THEN  Vrel=l-FRACT ( Relay ( 0 ) ) 

IF  Ncr 1 =3  THEN  Vrel=-1 

ELSE  !  manual  operation 

DISP  "Give  occupation  for  species  [ " ; VAL$(Ncrl ) ; 

INPUT  "]  or  (<0  ends  sequence )", Vrel 
END  IF 

IF  VrelcO  THEN 

LET  Tcrl=Ncrl-l  !  #  of  species  at  sequence  end 

LET  Frel ( Ncr 1 ) =0 
ELSE 

LET  Vsm=Vsm*Vrel 
LET  Frel ( Ncr 1 ) =Vsm 
END  IF 
END  I F 
NEXT  Ncr 1 

IF  VsmoO  THEN  LET  Vsm=Bcrl/Vsm 
FOR  Ncr 1  =  1  TO  Ter  1 

IF  Frel (Ncrl )<>0  THEN  Frel ( Ncrl ) =INT ( Frel ( Ncrl ) *Vsm+ . 5 ) 

IF  Vsm=0  THEN  Frel(Ncrl)=INT( Ncrl*Bcrl/Tcr 1+ . 5 ) 

NEXT  Ncrl 

EOR  Ncrl=Tcrl  TO  2  STEP  -1  !  Convert  to  allotments 

LET  Frel(Ncrl)=INT(Frel(Ncrl)-Frel(Ncrl-l)+.5) 

NEXT  Ncrl 


1  Accumulative  volume 


!  Normalize  to  Pixel  allotment 
1  Intergerize  up  to  Bcrl  total 


LET  Vsm=SUM( Frel ) 

IF  VamoBcrl  THEN  PRINT  "Unable  to  place  all  pixels,  see  SUB" 

IF  Relay( 1 ) =0  THEN 

PRINT  ”  pixs  allocations,  sum=" ;VAL$ ( Vsm) ; ” 

PR  I  NT  Frel ( * ) ; 

PRINT 
END  I F 

LET  Xc  0  1  Initialize  addresses 

I, FT  Yr  1 
LET  Zc  1 

EOR  Nn  1  -•  1  TO  Bcrl  !  Set  up  weights  tabulation 

LET  Xc-Xc* 1  i  to  avoid  excessive  recomputations 

IE  XOXmax  THEN 
LET  Xc= 1 
LET  Yc= Yc+  1 
IF  Yc>Ymax  THEN 
LET  Yc= 1 
LET  Zc  =  ZcU 
END  IF 
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19180  END  IF 

19190  LET  Vrel= ( Xc-1 ) * ( Xc-1 )+(Yc-l)*(Yc-l)+(Zc-l)*(Zc-l)  1  sep  difltdnc*- 

19200  SELECT  Crrl  !  select  correlation  potentials 

19210  CASE  =0 

19220  LET  Vrel=l 

19230  CASE  =1 

19240  LET  Vrel=EXP(SQR(Vrel)/Prel) 

19250  CASE  =2 

19260  IF  VreloO  THEN  Vrel=SQR( Vrel ) 

19270  CASE  =4 

19280  IF  VreloO  THEN  Vrel=Vrel  ‘  (  Prel  *  .  5  ) 

19290  END  SELECT 

19300  IF  Vrel=0  THEN 

19310  LET  Tabl ( Ncr 1 ) =0 

19320  ELSE 

19330  LET  Tabl ( Ncr 1 ) =Arel /Vrel 

19340  END  IF 

19350  NEXT  Ncrl 

19360  IF  Relay ( 1 ) =0  THEN  1  correlation  potentials  map 

19370  FOR  Xc=l  TO  Xmax 

19380  PRINT  "X-section  weight  to  origin,  plane  =”;Xc 

19390  FOR  Zc=2max  TO  1  STEP  -1 

19400  FOR  Yc= 1  TO  Ymax 

19410  LET  Ncrl=Xc+ (Yc-1) *Xmax+ (Zc-l)*Zcrl 

19420  PRINT  USING  .  |  "  " .  7A , # " ; VAL$ ( DROUND ( Tabl ( Ncr 1 ) , 3 )  ) 

19430  NEXT  Yc 

19440  PRINT 

19450  NEXT  Zc 

19460  NEXT  Xc 

19470  END  IF  1  end  if,  map 

19480  REM  Finding  the  weighting  field  .  > 

19490  PRINT  “  Wait  f i 1 1 ing" ; Bcrl ; "Pixels  in  SUB  Pixby  correlat" 

19500  LET  Rrel=RND  !  prime  the  RND  generator 

19510  FOR  Icrl=Bcrl  TO  1  STEP  -1  I  Roam  thru  random  fill  positions 

19520  LET  Kcrl=0 

19530  LET  Gcr 1 =0 

19540  FOR  Jcrl=l  TO  Tcrl  !  Fill  random  ordering  seguei.ce 

19550  IF  I NT (Frel(Jcrl))>.5  THEN 

19560  LET  Kcr 1 =Kcr 1 + INT ( Fre 1 ( Jcr 1 ) + . 5 )  1  summation  of  remaining  to  fi 

19570  LET  Gcrl=Gcrl+l  1  tally  of  remaining  pixel  species 

19580  END  IF 

19590  NEXT  Jcrl 

19600  IF  Gcrl>l  THEN  !  Fill  randomly, >1  pixels  to  fill 

19610  REPEAT 

19620  LET  Ncr 1= INT ( RND*Kcr 1 )  1  get  random  # 

19630  UNTIL  NcrlcKcrl 

19640  LET  Ncr l=Ncr 1+1 

19650  LET  Lcr 1=0 

19660  LET  Kcr  1=0 

19670  FOR  Jcr 1=1  TO  Tcrl 

19680  IF  Frel ( Jcrl ) >. 5  AND  Lcrl=0  THEN 

19690  LET  Kcrl=Kcrl+INT(Frel(Jcrl}+.5) 

19700  IF  Kcrl>=Ncrl  THEN  1  contains  address  of  non-zero 

19710  LET  Lcr l=Jcrl 

19720  LET  Fre 1 ( Lcr 1 ) =Frel ( Lcr 1 ) -1 1  reduce  one  more 
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10  7(0 

107  40 
,97  SO 
10  7  00 
10770 
19780 
10700 
10800 
10810 
1  0870 

108  10 
I  0840 
1  08  SO 
I  0800 
1  08  /O 
1  0881) 
1  0  800 
1  0000 
1  00  10 
199/1) 
100  10 
10040 
1O0S0 
10000 
100  70 
1  0080 
]  0000 
,:'00()0 
7  0010 
7 1 '070 
700  10 
,'0040 
.•on*.  1 1 

,■90  0  0 
.  Ill)  /l< 

.  oonn 

.  909(1 
7  0  1  09 

79  1  ;  o 

7nl/i) 
7  0  1  10 
70  1  40 
70  190 
70  190 
71)  1  It) 

7  0  18  0 

70  no 
70  700 
70/  I  O 
707  70 
707  tO 
7074(1 
7  07  SO 
70/1,0 
707  /(I 


END  IF 
END  IF 
NEXT  Jcr 1 

PRINT  " [ " ;VAL$(LcrI) ; " ] " ; 

MAT  Wrel= ( 0 ) 

LET  Kcr 1=0 

FOR  Jcrl=l  TO  Bcrl  !  Find  pixel  weighting  field 

LET  Zc= ( Jcrl-1 )  DIV  Zcr 1 
LET  Xc= (Jcrl-1 )  MOD  Zcr 1 
LET  Yc  =  Xc  DIV  Xmax 
LET  Xc=Xc  MOD  Xmax 

IF  Pixl(Jcrl)=0  THEN  1  for  unfilled  or  zeroed  pixels 

LET  Kcrl=Kcrl+l 
FOR  Ncr 1  =  1  TO  Bcrl 

IF  P ix 1 ( Ncr 1 ) =Lcr 1  THEN  !  This  pixel  contributes  to  weighting 
LET  Zdf=ABS( ( (Ncrl-1)  DIV  Zcrl)-Zc) 

LET  Qcrl= (Ncrl-1 )  MOD  Zerl 
LET  Ydf=ABS( (Qcrl  DIV  Xmax)-Yc) 

LET  Xdf=ABS( (Qcrl  MOD  Xmax)-Xc) 

LET  Qcr l=l+Xdf+Ydf *Xmax+Zdf *Zcrl 1  for  tabulation  c_dress 
1  LET  Vrel=Xdf *Xdf+Ydf *Ydf+Zdf *Zdf  ISguare  of  rel  diff  in  addr 
IF  Qcr 1>0  THEN  Wrel ( Kcr 1 ) =Wrel ( Kcrl ) +Tabl (Qcrl ) 

END  IF  1  end  if,  Pixl=Lcrl  test 

NEXT  Ncr 1 

END  IF  !  end  if,  Pixl=0  test 

NEXT  Jcr 1 
LET  Vsm  =  0 

FOR  Jcrl-1  TO  Kcrl  !  total  of  weighting 

LET  Vsm=V8m+Wrel ( Jcrl ) 

NEXT  Jcrl 
IF  Vsm<  =  0  THEN 

FOR  Jcr  1  =  1  TO  Kcrl 
LET  Wre  1  (Jcrl  )  =  1 
NEXT  Jcrl 
LET  V:;m-K<  rl 
PRINT  "c"; 

END  IE 

IE  lcrl<8crl-J  AND  Icrl>Bcrl-5  THEN  !  Set  for  intermediate  printout 
PRINT 

PRINT  ”  Weighting  map  at  fill  ;  VAL$  (  Bcr  1- Icr  1  +  1 )  ;  ”  :  ” 

FOR  Zd  f  =  1  TO  Zmax 

PRINT  ”  Pixels  in  Z-sectional  plane”;Zdf; 

PRINT  "(interaction  to  ( " ;VAL$ (Lcrl ) ; ” ) ) " 

FOR  Y d  f  =  1  TO  Ymax 

LET  Jcrl= ( Ydf-1 ) *Xmax+ ( Zdf-1 ) *Zcr 1 
FOR  Xdf  =  I  TO  Xmax 
LET  Qcr l=Jcr 1+Xdf 

PRINT  USING  "2X, A, 3X, #" ; VAL$ ( Pix 1 (Qcr 1 ) ) 

NEXT  Xdf 
PRINT 
NEXT  Yd  f 
NEXT  Zdf 
LET  Qcrl  0 
LET  Zdf  () 

FOR  Jcrl  1  TO  Bcrl 
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20280 

20290 

20300 

20310 

20320 

20330 

20340 

20350 

20360 

20370 

20380 

20390 

20400 

20410 

20420 

20430 

20440 

20450 

20460 

20470 

20480 

20490 

20500 

20510 

20520 

20530 

20540 

20550 

20560 

20570 

20580 

20590 

20600 

20610 

20620 

20630 

20640 

20650 

20660 

20670 

20680 

20690 

20700 

20710 

20720 

20730 

20740 

20750 

20760 

20770 

20780 

20790 

20800 

20810 

20820 


! 

i 

1 

! 

! 

! 

! 

; 

! 


1 


IF  ( Jcrl-1 )  MOD  Zcr 1=0  THEN 
LET  Zdf =Zdf +1 

PRINT  "WeightB  in  Z  plane";Zdf 

END  IF 

IF  Pixl { Jcrl ) =0  THEN 
LET  Qcrl=Qcr 1+ 1 


PRINT  USING  |  •■”,7A,#";VAL$(INT(Wrel(Qcrl)  +  .5)  ) 
ELSE 

PRINT  "| none 
END  IF 

IF  Jcrl  MOD  Xmax=0  THEN  PRINT 
NEXT  Jcrl 


END  IF  1 

REPEAT  1 

LET  Rrel=RND*Vsm 
UNTIL  Rrel<Vsm 

LET  Qcr 1=1  1 

LET  Kcrl=0  ! 

LET  Vsm=0  1 

FOR  Jcr 1= 1  TO  Bcrl 

IF  Qcr 1  AND  Pixl (Jcrl ) =0  THEN 
LET  Kcrl=Kcrl+l  ! 

LET  Vsm=Vsm+Wrel (Kcrl )  ! 

IF  Vsm>Rrel  THEN  ! 

LET  Pixl (Jcrl ) =Lcrl  1 

LET  Qcr 1=0  < 


end  if,  intermediate  printout 
Get  a  RANDOM  i 

Testing  switch  is  set  to  ON 
Keep  tally  of  Pixels  with  zeros 
Zero  weighting  accumulator 

!  Test  if  Pixel  iB  zero 
Further  assign  if  =  RANDOM  # 
Accumalative  weight 
Trips  when  reach  RANDOM  0 
Pixel  assigned 
No  more  testing  set 


END  IF 

END  IF  1  end  if,  Pixl=0  test 

NEXT  Jcrl 

ELSE  !  Only  0  OR  1  TYPES,  fast  fill 

LET  Lcr 1=0 
FOR  Jcrl=l  TO  Ter 1 

IF  Frel ( Jcrl )<>0  THEN  Lcrl=Jcrl 
NEXT  Jcrl 
IF  Lcrl>0  THEN 


FOR  Jcrl=l  TO  Bcrl  !  filling  the  remaining,  1  type 

IF  Pixl (Jcrl ) =0  THEN 
LET  Pixl (Jcrl ) =Lcrl 
LET  Frel ( Lcrl ) =Frel (Lcr 1 ) -1 
END  IF 
NEXT  Jcrl 
END  IF 

END  IF  1  end  if,  Gcrl>l  test 

NEXT  lcrl 

IF  Relay ( 1 ) =0  THEN  PRINT  " ; SUM ( Frel ) ; " remain, ” 

DEALLOCATE  Tabl ( * ) , Wrel ( * )  !  Bye-bye  variable  sub  arrays 

SUBEND 

SUB  Pixs_by_evol v ( INTEGER  Gpcs) 

COM  /Pass/Relay(0: 7 ) 

COM  /Pixel/  INTEGER  Xmax , Ymax , Zmax , P ix 1 ( 1 : 8000 ), REAL  Xsc 1 , Ysc 1 , Zsc 1 
INTEGER  Cnk, Clmx , Gens , Shv , Fadr ,Rlr,Mdl,Mlkl,Mlk2,Nsft,Rset,Sadr,Vlv 
INTEGER  Gski,Kski,Mski,Qski,Sski,Xski,Yski,Zski,Ncs(0:9),Pcs(0:9) 
REAL  Agen , Dv, Prpt , Vski , Dmd ( 0 : 9 ) 

LET  Cnk=Xmax*Ymax*Zmax 


FOR  Sski=l  TO  Cnk 
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1  Need  to  zero  out  pixels 


208 JO  LET  P  ixl ( Sski ) =0 

20840  NEXT  Sski 
2 08 SO  LET  Vski=0  1  Volume  fraction 

20860  LET  Mski= ( Relay ( 1 ) =0 )  !  manual  indicator 

2.0870  LET  Rset  =  Relay  ( 2 )  1  Pass  vols  preservation 

70880  LET  Rset=BIT < Rset , 0 ) 

20890  LET  Gens=Relay ( 3 )  1  Pass  generation  size 

20900  LET  Vlv=Relay(4)  !  Evolution  starter 

20910  LET  Prpt=FRACT < Relay ( 5 ) )  1  proportion  change 

20920  IF  Gpcs=0  THEN  Gpcs=2  i  default  to  binary 

20930  IF  Mski  THEN 
20940  DISP 

209SO  INPUT  "Random  seed?  (negative  to  timer,  none=0)",Shv 

20960  IF  shv=0  THEN  1  From  generation  to  generation 

20970  LET  Rset=l  !  preserve  vol  fractions 

20980  ELSE 

20990  DISP  "Maintain  constant  parent  to  descendent”; 

21000  DISP  "  ratios?  Vary=0  Fixed=l  (def ault=” ; VAL$ ( Rset ) ; 

21010  INPUT  " ) " , Rset 

21020  LET  Rset  =  BIT  (  Rset ,  0  ) 

71030  LET  Relay ( 2 ) =Rset 

21040  END  IF 

2I0S0  DISP  "Generations  of  evolution?  (self  determined,  default=” ;Gens; 

21060  INPUT  " ) " , Gens 

21070  LET  Relay ( 3 ) =Gens 

21080  ELSE  !  get  parameters  from  Relays 

71090  LET  Shv=Re lay ( 1 )  !  seed 

2 1 100  I E  Shv=0  THEN 

2  1110  LET  Rset -  1 

21170  ELSE 

2  I  1  10  LET  Gpcs-2 

7  1  140  Dmd ( 1 ) - FRACT ( Relay ( 0 ) ) 

2 1  ISO  Dmd ( 2 )  =  1-Dmd ( 1 ) 

2 1 160  END  I F 

711/0  END  IE  1  end  if,  relays 

2  1  I  80  I E  Germ- 0  THEN 

21190  LET  Agen-MAX ( Xmax , Ymax, Zmax )  !  set  Gens  upward  integer 

7  1200  LET  Gens  =  - I  NT ( 1 -LOG ( Agen ) /LOG (2.0) ) 

7  12  10  END  I  E 
7  1770  IE  ( i * ■  1 1 i J 0  THEN  STOP 

7 17  to  IE  Gens- 0  THEN  PRINT  "No  evolutions?" 

2  1210  LET  Qnk i  =  7  t  elements  per  expansion  cube 

7 1 7 SO  LET  Mlkl  =  Xmax  !  set  multipiers  for  addresses 

21760  if  Xmax-1  THEN  Mlkl=Ymax 
71270  LET  Mlk2=Xmax*Ymax 

2I2MO  if  Xmax  = 1  THEN  LET  Qski=SHI FT ( Qski , 1 ) 

21290  ie  Ymax- 1  THEN  LET  Qsk i=SHI FT ( Qski , 1 ) 

21100  IF  Zmax- 1  THEN  LET  Qski=SHI FT (Qski , 1 ) 

21 110  LET  O 1 mx=Qsk i + 1 

2)120  ALLOCATE  REAL  Ru 1 s ( 0 : Gpcs , 0 : 9 ) 

2  11)0  if  Sliv >0  THEN  RANDOMIZE  Shv  !  Seeding  random  generator 

2  1  140  IE  Shv  0  THEN  RANDOMIZE  TIMEDATE  MOD  32767 

7  1  ISO  I  E  Miik  i  THEN 

21  16*)  PRINT  ”  ", Gens; "generations  could  expand  to  fill  a  cube  sized"; 

71170  LET  Agen  (2.0) ' (Gens+1.0)  1  Pixel  cube  edge 
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21380 
21390 
21400 
21410 
21420 
21430 
21440 
214S0 
21460 
21470 
21480 
21490 
21500 
21510 
21520 
2  1530 
21540 
2  1550 
2  1560 
21570 
21580 
21590 
21600 
21610 
21620 
21630 
21640 
21650 
21660 
21670 
21680 
21690 
21700 
21710 
21720 
21730 
21740 
21750 
21760 
2  1770 
21780 
21790 
21800 
21810 
21820 
21830 
21840 
21850 
21860 
21870 
21880 
21890 
21900 
21910 
21920 


PRINT  "  - ;VAL$(Agen) ; "x" ;VAL$(Agen) ; "x ” ; VAL$ ( Agen ) ; ” . ” 

END  IF 

IF  Shv=0  THEN  1  generate  pattern  fills 

FOR  Gski=l  TO  Gpcs  1  up  to  9  species 

FOR  Sski=0  TO  Qski  1  bit  ordering  of  Sski  iB  (Z,Y,X)u 

LET  Ruls (Gski , Sski ) =Gski  I  default 
DISP  "Evolution  from  parent  species  [ " ; VAL$ (Gski ) ; 

DISP  " ] ,  sector  ( " ; VAL$ (BIT(Sski,0) ) ; 

IF  Qski>l  THEN  DISP  "  ,  ;  VAL$  (  BIT  (  Sski ,  1 ))  ; 

IF  Qski>3  THEN  DISP  " , “ ; VAL$ ( B IT ( Sski  ,  2 ) ) ; 

DISP  ")  is  to  species?  ( def au It = ( " ; VAL$ ( Gsk i ) ; 

INPUT  " ) )"<Ruls(Gski,Sski) 

LET  Ruls(Gski,Sski)=INT( .5+Ruls(Gski,Sski) ) 

NEXT  Sski 
NEXT  Gski 
ELSE 

IF  Rset=l  THEN  !  get  shuffle  fills 

FOR  Gski=l  TO  Gpcs 
LET  Md 1 =0 
LET  Kski=0 

FOR  Sski=Clmx  TO  1  STEP  -1 
WHILE  Mdl<l  AND  Kski<=Gpcs 

LET  Kski=Kski+l  !  current  species  fill 

IF  Mski  THEN 

DISP  "How  many  descendants  for  species  ( " ; VAL$ ( Ksk i ) ; 
DISP  ”)  evolve  from  parent  species  | " ; VAL$ (Gski  ) ; "  ]  "  ; 
DISP  '•  (up  to  “  ;  VAL$  ( Sski  )  ; 

INPUT  ")",Mdl 
ELSE 

IF  Kski=Gski  THEN 

LET  Mdl= ( 1-Prpt ) *Qski+ . 5 
ELSE 

LET  Mdl=Prpt*Qski 
END  IF 

END  IF  !  endif,  Mski=0  test 

END  WHILE  !  endif,  Mdlcl  te3t 

LET  Ru 1 s (Gski , Clmx-Sski ) =Ksk i 
LET  Md 1 =Md 1-1 
NEXT  Sski 
NEXT  Gski 

ELSE  !  else,  fill  by  demands 

LET  Ruls ( 0 , 0 ) =0 
LET  Nsf t=0 
IF  Mski  THEN 

DISP  "Establish  all  species  with  same  probable  descendancy"; 
INPUT  "  pattern?  0=No  l=yes  ",Nsft 
ELSE 

LET  Nsf t  =  1 
END  IF 

LET  Ns f t  =  ( Nsf t >0 ) 

IF  Ns f t  THEN 
IF  Mski  THEN 

DISP  "What  is  fractional  chance  of  parents  descendi ng”  ; 

DISP  "  other  species?  ( def aul t  =  ” ; VAL$ ( Prpt )  ; 

INPUT  " ) " , Prpt 
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2  1  9  JO 
2  1940 
2  1990 
2  I960 
2  1  970 
2  1980 
2  1990 
22000 
22010 
22020 
22030 
22040 
220  >0 
27060 
7  2070 
7  2080 
27090 
22  1  00 
7  3  1  10 
22  120 

2  2  1  30 

3  2  140 
22  1  SO 

2  7  160 

3  3  1  70 
77  180 
7  7  1  90 
77200 
312  10 
37230 
372  Ul 
2  3  2  40 
272  SO 
32260 
2  23  /O 

2  7  2  60 
77290 

3  2  )0O 
2  2  1  10 
27  170 
37  <  10 
7  7  140 
7  3  ISO 
3  7  160 
7  7  1  /() 
77  180 
33  190 
22400 
724  10 
27420 
224  10 
23440 
2  2  4SO 
22460 
32470 


IF  Prpt<0  OR  Prpt>l  THEN  Prpt=FRACT ( Prpt ) 

END  IF  1  endif,  Mski  else  Prpt  defaults 

IF  Gpcs=l  THEN 
LET  Ru 1  s  (  1 , 1 )  =  1 
ELSE 

FOR  Gski= 1  TO  Gpcs 
FOR  Sski=l  TO  Gpcs 
IF  Sski=Gski  THEN 

LET  Ruls(Gski, Sski)=l-Prpt 
ELSE 

LET  Ruls( Gski, Sski) =Prpt/ (Gpcs-1 ) 

END  IF 
NEXT  Sski 
NEXT  Gski 
END  IF 

END  IF  1  endif,  Nsft  test 

IF  NOT  Nsft  THEN 

FOR  Gski=l  TO  Gpcs  !  up  to  9  species 

LET  Vski =0 
LET  Ru 1 s ( Gski , 0 ) =0 

FOR  Sski=l  TO  Gpcs  !  up  to  9  species  evolutions 

LET  Ru Is (Gski , Sski ) =1/Gpcs !  default 
IF  Mski  THEN 

DISP  "Occupation  most  probable"; 

DISP  "  for  species  [ ” ; VAL$ ( Sski ) ; 

DISP  ")  descending  from  parent  species  | " ; VAL$ (GBki ) ; 
INPUT  " ]?",Ruls(Gski,Sski) 

ELSE 

IF  Gski=Sski  THEN 


LET  Ru 1 s (Gski , Sski )= 1-Prpt 
ELSE 

LET  Ruls(Gski,Sski) =Prpt / ( 1-Prpt ) 

END  IF 
END  IF 

LET  Vski=Vski+Ruls (Gski, Sski ) 

NEXT  Sski 

IF  VskioO  THEN  Vski  =  l/Vski 

IF  VskioO  THEN  t  normalize  evolution  requests 

FOR  Sski= 1  TO  Gski 


LET  Ruls(Gski,Sski)=Ruls(Gski,Sski) *Vski 


NEXT  Sski 
END  IF 
NEXT  Gski 
END  IE 
END  IF 
END  I  F 

IF  Mski  THEN 

DISP  "Use  which  species  as  the 
DISP  "  (O=from  user,  default=” 
INPUT  " ) " , V I v 
LET  Relay ( 4 ) =Vlv 
END  I F 

r  F  Shv-0  THEN 

FOR  Sski=0  TO  Qski 

LET  Xski=BIT(Sski,0)+BIT(Ssk 


!  endif,  not  Nsft  test 
!  endif,  Rset  test 
1  endif,  Shv=0  test 
1  imprint? 

STARTER  evolutionary  pattern?"; 
VAL$ (Vlv) ; 


!  set  up  of  2x2x2  Pixel  fill 
,  1) *Mlkl  +  BIT(Sski,2 ) *Mlk2+l 
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22480 

22490 

22500 

22510 

22520 

22530 

22540 

22550 

22560 

22570 

22580 

22590 

22600 

22610 

22620 

22630 

22640 

22650 

22660 

22670 

22680 

22690 

22700 

22710 

22720 

22730 

22740 

22750 

22760 

22770 

22780 

22790 

22800 

22810 

22320 

22830 

22840 

22850 

22860 

22870 

22880 

22890 

22900 

22910 

22920 

22930 

22940 

22950 

22960 

22970 

22980 

22990 

23000 

23010 

23020 


IF  VI  v  =  0  THEN 

LET  Pixl ( Xski ) =BIT ( BIT ( Sski, 0)+BIT( Sski, 1 ) +BIT ( Sski , 2 ) , 0)+ 1 
DISP  "Give  STARTER  species  at  Pixel (" ;VAL$ ( BIT ( Sski , 0 )+ 1 ) ; 

IF  Qski>l  THEN  DISP  VALS ( BIT ( Sski , 1 )+ 1 ) ; 

IF  Qski>3  THEN  DISP  " , ” ; VAL$ ( BIT ( Sski , 2 ) + 1 ) ; 

INPUT  " ) " , Pixl (Xski) 

ELSE 

LET  Pixl (Xski ) =Ruls (VI v, Sski ) 

END  IF 
NEXT  Sski 

ELSE  1  initial  random  fill  ShvoO 

IF  Reet  THEN  1  fill  pixels  directly  fr  Ruin 

LET  Mdi=0 
LET  Kski=0 

FOR  Sski=Clmx  TO  1  STEP  -1 
WHILE  Md 1<1  AND  Kski<=Gpcs 

LET  Kski=Kski+l  l  current  species  fill 

IF  Mski  THEN 

DISP  "How  many  STARTER  pixels  for  species  ( ” ; VALS ( Kski ) ; 
DISP  "]  (up  to  " ; VALS (Sski) ; 

INPUT  " )  "  ,Mdl 
ELSE 

IF  Kski=Gski  THEN 

LET  Mdl= ( 1-Prpt ) *Qski+ . 5 
ELSE 

LET  Mdl=Prpt*Qski 
END  IF 

END  IF  1  endif,  Maki=0  test 

END  WHILE  !  endif,  Mdlcl  test 

LET  Pixl (Sski)=Kski 
LET  Md 1 =Md 1- 1 
NEXT  Sski 

ELSE  !  else  Rset  =  0,  get  volume  f  i  .id  ionu 

IF  Mski  THEN 
LET  Vski=0 
FOR  Sski=l  TO  Gpcs 

IF  Vlv=0  THEN  DISP  "STARTER/"; 

DISP  "CONVERGENCE  occupation  value"; 

DISP  "  saught  for  species  (”; VALS ( Sski ) ; 

INPUT  " ] ",Dmd(Sski) 

LET  Vski=Vski+Dmd ( Sski ) 

NEXT  Sski 
IF  Vski=0  THEN 
LET  Vski=l/Gpcs 
ELSE 

LET  Vski=l/Vski 
END  IF 

FOR  Sski=l  TO  Gpcs  !  normalize  volume  fractions 

LET  Dmd ( Sski ) =Dmd ( Sski ) *Vski 
NEXT  Sski 

END  IF  1  endif,  else  use  default  Dmd 

LET  Dv -SUM (Dmd) 

IF  Dv=0  THEN  1  if  0,form  default  demands 

FOR  Sski=l  TO  Gpcs 

IF  V 1 v=0  OR  Gpcs= 1  THEN 
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i  flat  Demands 


2  JO  JO 
2  .1040 
2  10S0 
2  10 60 
2  1070 
2  .1080 
2  1090 
2  11(H) 
2  1110 
2  1120 
2.1130 
23  140 
2  1  ISO 
2  3  ISO 
2  1170 
2  1180 
2.3190 
2  3200 
2  12  10 
2  1220 
2  12  30 
2  1240 
2  3 2 SO 
2  12  00 
2  12  70 
2  1280 
2  1290 
2  3  100 
2  1110 
2  1  120 
2  1  1  10 
2  1  140 
2  I  ISO 
2  1  100 
2  1  3  70 
2  1  180 
1  190 
2  1400 
2  14  10 
2  14  20 
2  14  10 
2  1440 
2  1 4  SO 
2  14  00 
2  14  70 
2  14)10 
2  1490 
2  3  son 
2  IS  1  0 
2  1 S  20 
2  IS  30 
2  1S40 
2  1SS0 
2  1S00 
2  1S70 


LET  Dmd ( Sski ) =1/Gpcs 
ELSE 

IF  Sski=Vlv  THEN 

LET  Dmd  ( Sski  )=1-P»:pt  !  proportionate  Demands 

ELSE 

LET  Dmd ( Sski ) =Prpt /(Gpca-1) 

END  IF 
END  IF 
NEXT  Sski 
END  IF 
LET  Vski=0 
LET  Kski=0 

FOR  Sski= 1  TO  Gpcs  1  fill  pixels  according  to  demands 

IF  Vlv=0  THEN 

LET  Vski=Vski+Dmd ( Sski ) *Clmx 
ELSE 

LET  Vski=Vski+Ruls ( Vlv, Sski) *Clmx 
END  IF 

WHILE  Ksk i< I NT ( Vski+ . 5 ) 

LET  Ksk i=Kski+ 1 
LET  Pixl (Kski)=Sski 
END  WHILE 
NEXT  Sski 

END  IF  !  endif,  getting  vol  fractions 

FOR  Ssk  i  =  1  TO  SHI  FT ( Clmx , 1 ) 

REPEAT  !  uses  1st  2  bit  triples=6  bits  total 

LET  Ns  f t  =  INT ( RND*  64 ) 

UNTIL  Nsf t<64  !  &  mask  out  what  is  needed 

LET  Md 1 =BINAND ( SHIFT ( Nsf t , 3 ) ,Qski)+l 
LET  Nsf t  =  BI NAND (Nsft,Qski)+l 
LET  Kski=Pixl (Mdl) 

LET  Pixl (Mdl ) =Pixl (Nsft) 

LET  Pixl (Nsft)=Kski 
NEXT  Sski 

FOR  Sgki-Qski  TO  0  STEP  -1  !  move  Pixels  outward 

LET  Xs ’m=b;t ( Sski, 0)+BIT( Sski, 1 ) *Mlkl+BIT ( Sski , 2 ) *Mlk2  +  l 
LET  Pixl (Xski)=Pixl (Sski+1) 

IF  Xski<>Sski+l  THEN  LET  Pix 1 ( Sski+ 1 ) =0 
NEXT  Sski 

END  if  1  endif,  Shv=0  test,  imprinting 

IF  Knot  1  THEN  !  form  numbering  sequence 

FOR  Saki=0  TO  Qski  !  to  be  shuffled  later 

LET  Ncs ( Ssk i ) =Sski 
NEXT  Sski 
END  I F 

LET  Dv-0  !  Total  servo  volume  request 

IF  ShvoO  AND  NOT  Rset  THEN 
LET  Dv=SUM ( Dmd ) 

IF  Dv<> 1  THEN  PRINT  "  Norm?  SERVO  vol  =";Dv;"in  SUB  evolv” 

END  I F 

FOR  Gski=l  TO  Cen3 
IF  Dv>0  THEN 
MAT  Pcs=(0) 

LET  Kski-0 

FOR  Sski  1  TO  Cnk  !  tally  for  adjusting 
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23580 
23590 
23600 
23610 
23620 
23630 
23640 
23650 
23660 
23670 
23680 
23690 
23700 
23710 
23720 
23730 
23740 
23750 
23760 
23770 
23780 
23790 
23800 
2  3  310 
23820 
23830 
23840 
23850 
23860 
23870 
23880 
23890 
23900 
23910 
23920 
23930 
23940 
23950 
23960 
23970 
2  3980 
2  3990 
24000 
24010 
24020 
24030 
24040 
24050 
24760 
24070 
24080 
2  4090 
24100 
24110 
24120 


LET  Pcs(Pixl(Sski) )=Pcs(Pixl(£aki) )  + 1 
IF  Pixl ( Sski ) >0  THEN  Kski=Kski+l 
NEXT  Sski 

FOR  Sski=l  TO  Gpcs 
IF  Kski=0  THEN 

LET  Ruls ( 0 , Sski ) =0 
ELSE 

LET  Ru Is { 0 , Sski ) =0  !  estimate  probable  fills 

FOR  Xski=l  TO  Gpcs 

LET  Ruls(0,Sski)=Ruls(0,Sski)+(Pcs(Xski)/Kski)*Ruls(Xski,Sski) 
NEXT  Xski  !  servo  coefficients 

LET  Ruls(0,Sski)=( Dmd (Sski)-Ruls(0,Sski) ) 

END  IF 
NEXT  Sski 
END  IF 

FOR  Zski=BINAND(-2< Zmax+l)-i  TO  1  STEP  -2  i  2  fold 
FOR  Yski=BINAND(-2,Ymax+l)-l  TO  1  STEP  -2 
FOR  Xski  =  BINAND(-2, Xmax  + 1 ) -  1  TO  1  STEP  -2 

LET  Fadr=Xski+ ( Yski- 1 ) *Xmax+ ( Zski-1 ) *M1 k2  !  new  address 
LET  Sadr=SHIFT(Xski+l, l)+SHIFT(Yski-l,l) *Xmax 
uET  Sadr=Sadr +SHI FT ( Zski-1 , 1 ) *Mlk2  !  source  address 
LET  Rlr=Pixl (Sadr)  !  Pixel  to  be  2  folded 

LET  Pix 1 ( Sadr ) =0 

IF  Shv<>0  AND  Rset=l  THEN  1  shuffle  the  sequencing 
FOR  Ssk i= 1  TO  SHIFT ( Clmx , 1 ) 

REPKA !  uses  1st  2  bit  triples  =  6  bits  tot.  al 
LET  Ns f t  =  INT ( RND*64 ) 

UNTIL  Nsf t<64  1  &  mask  out  what  is  needed 

LET  Md 1=BINAND ( SHIFT ( Nsf t , 3 ) ,Qski) 

LET  Nsf t=BINAND ( Nsf t , Qski ) 

LET  Kski=Ncs (Mdl ) 

LET  Ncs ( Mdl )=Ncs(Nsft) 

LET  Ncs(Nsft)=Kski 
NEXT  Sski 
END  IF 

FOR  Sski=0  TO  Qski 

LET  Kski=BIT(Sski, 0) +BIT(Sski, 1  )*Mlkl-»BIT(Saki,2)*Mlk2 
LET  Kski=Kski+Fadr  l  Final  new  address 

IF  Rlr=0  OR  Rl r>Gpcs  THEN 
T ET  Pixl(Kski)=0 
ELSE 

IF  Shv=0  OR  Rset  THEN  1  Fill  by  numbers  in  Ruls 
LET  Pixl (Kski ) =Ru 1 s ( Rl r , Ncs ( Sski  )  ) 

ELSE  !  Fill  by  probabilities 

LET  Agen=RND 
LET  Vski=0 
LET  Mdl=0 
REPEAT 

LET  Mdl=Mdl+ 1 

LET  Vski=Vski+Ruls ( Rlr , Mdl ) +Ru Is ( 0 , Mdl ) 

UNTIL  Vski>=Agen  OR  Mdl=Gpcs 
LET  Pixl (Kski) =Mdl 
END  IF 
END  IF 
NEXT  Sski 
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<'4  1  JO 
7  4140 
4  ISO 
.'4  1  f,0 
2  4  1  70 

241  80 
<■4  190 
<'4  7.00 

242  10 
24220 
242  JO 


NEXT  Xski 
NEXT  Yski 
NEXT  Zski 
NEXT  Gski 
LET  Kski=0 
FOR  Saki= 1  TO  Cnk 

LET  Kski=Kski+ ( Pixl ( Sski ) =0 ) 

NEXT  Sski 

IF  Kski>0  THEN  PRINT  Kaki ; "empty ?  pixels  returned,  SUB  evolv" 
DEALLOCATE  Ruls(»)  1  Bye-bye  variable  sub  arrays 

SUBEND 

-*-*  —  *  —  «  —  *_*  —  *  —  *  —  *_*_*_* 
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US  Army  Material  Systems  Analysis  Actv 
ATTN:  DRXSY-MP 

00T  Aberdeen  Proving  Ground,  MD  2100S 

Commander,  AMC 
ATTN:  AMCDE-SC 
5001  Eisenhower  Ave. 

001  Alexandria,  VA  22333-0001 

Commander,  LABCOM 

ATTN:  AMSLC-CG ,  CD,  CS  (in  turn) 

2800  Powder  Mill  Road 
001  Adel  phi ,  MD  20783-1145 

Commander,  LABCOM 
ATTN:  AMSLC-CT 
2800  Powder  Mill  Road 
001  Adel  phi  ,  MD  20783-1145 

Commander, 

IJS  Army  Laboratory  Command 
Fort  Monmouth,  NJ  07703-5601 
1  -  SLCET-DD 

1  -  SLCET-OT  (M.  Howard) 

1  -  SLCET-DR-B 

22  -  Originating  Office 

Commander,  CECOM 

R&D  Technical  Library 

Fort  Monmouth,  NJ  07703-5703 

1  -  ASQNC-ELC-IS-L-P.  (Tech  Library) 

3  -  ASQNC-ELC- IS-L-R  (STINFO) 

Advisory  Group  on  Electron  Devices 
AT  IN:  Documents 
2011  Crystal  Drive,  Suite  307 
002  Arlington,  VA  22202 
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Director  Cdr,  Atmospheric  Sciences  Lab 

Naval  Research  Laboratory  LABCOM 

A I T  N :  CODE  2627  ATTN:  SLCAS-SY-S 

UOl  Washington,  DC  20375-5000  001  White  Sands  Missile  Range,  NM  08002 

Cdr,  PM  JTPUSION 
ATTN:  JTT 

1500  (Manning  Research  Dr 
001  McLean,  VA  22102 

Rome  Air  Development  Center 
ATTN:  Documents  Library  (TILD) 

001  Griffis  AFB ,  NY  13441 

Deputy  for  Science  A  Technology 
Office,  Asst  Sec  Army  (R&D) 

UOl  Washington,  DC  20310 

fl()DA  ( DAMA-ARZ-D/Dr .  F.D.  Verderame) 

nol  Washington,  DC  20310 

Dir,  llectronic  Warfare/Reconnaissance 
Surveillance  A  Target  Acquisition  Dir 
A I T N :  AMSEL-RD-EW-D 
001  (ort  Monmouth,  NJ  07703-5206 

Dir,  Reconnaissance  Surveillance  & 

I  argot  Acquisition  Systems  Dir 
AT  IN:  AMSEL-RD-EW-DR 
001  I ort  Monmouth,  NJ  07703-5206 

Cdr,  Marine  Corps  Liaison  Office 
A!  Hi:  AMSEL-LN-MC 
ooi  luit  Monmouth,  fid  0/703-5033 

bit  ,  IIS  Army  Signals  Warfare  Dir 
A! IN:  AMSEI -RD-SW-OS 
Vint  Hill  farms  Station 
OOI  Warrenton,  VA  22186-5100 

Dir,  Night  Vision  &  Electro-Optics  Dir 
(.1  COM 

ANN:  AMSEL-RD-NV-D 
OOI  fort  lie  1  voir,  VA  22060-5677 


Cdr,  Harry  Diamond  Laboratories 
ATTN:  SLCHD-CO ,  TD  (in  turn) 
2800  Powder  Mill  Road 
001  Adel  phi ,  MD  20783-1145 
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